比较单元格与前一个单元格,如果其他地方粘贴数据不同,则增加

时间:2013-06-12 15:55:18

标签: excel vba

我正在尝试为Excel编写一个VBA宏,它将向下移动一列并将一个单元格与前一个单元格进行比较,以查看它们是否相同。如果它们是相同的,我希望它什么也不做,继续沿着列。如果它们不相同,那么我想复制该行中的多个列并将它们粘贴到单独的选项卡或电子表格中。

基本上我的数据是每两秒一次的压力列表,我有数千个数据点。我只想输出压力和经过的时间,以便我有一个更小的数据集更有用。基本上我想清理我的数据,只显示压力的变化和压力变化的时间。

我能够找到一个有效的宏。

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

1 个答案:

答案 0 :(得分:0)

希望这会有所帮助。如果这有帮助,请标记为已回答!

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