vba 将单元格与前一个单元格进行比较，如果在其他地方粘贴数据不同，则增加
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17070024/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Compare cell to previous cell and if different paste data elsewhere, else increment
提问by user2479061
I am trying to write a VBA macro for Excel that will go down one column and compare one cell to the previous cell to see if they are the same or not. If they are the same I want it to do nothing and continue on down the column. If they are not the same then I want to copy multiple columns in that row and paste them in a separate tab or spreadsheet.
我正在尝试为 Excel 编写一个 VBA 宏，该宏将向下一列并将一个单元格与前一个单元格进行比较，以查看它们是否相同。如果它们相同，我希望它什么都不做并继续沿着列向下。如果它们不相同，那么我想复制该行中的多列并将它们粘贴到单独的选项卡或电子表格中。
Basically my data is a list of pressures taken every two seconds and I have thousands of data points. I want to export only the pressure and elapsed time so that I have a much smaller set of data that is more useful. Basically I want to clean up my data to only show changes in pressure and the times at which the pressures change.
基本上我的数据是每两秒采取的压力列表，我有数千个数据点。我只想导出压力和经过的时间，以便我拥有更有用的小得多的数据集。基本上我想清理我的数据以只显示压力的变化和压力变化的时间。
I was able to figure out a macro that works.
我能够找出一个有效的宏。
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 3725 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("C").Column).Value <> Cells(r + 1, Columns("C").Column).Value Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
End Sub
回答by artis_meditari
Hope this helps. Mark as answered if this helps!
希望这可以帮助。如果这有帮助，请标记为已回答！
Sub compare()(
for I = 2 to Sheets("Sheet1").Cells(Rows.Count,"A").End(xlup).Row
If Sheets("Sheet1").Range("A" & I)<>Sheets("Sheet1").Range("A" & I-1) then
'move data
For j = 1 to rows
For k = 1 to columns
Sheets("Sheet2").cells(j,k)=Sheets("Sheet1").cells(j,k)
Sheets("Sheet3").cells(j,k)=Sheets("Sheet1").cells(j,k)
Next k
Next j
End if
Next I
End Sub
