檢查細胞

的價值觀，我試圖做Excel中的以下內容：檢查細胞

我有一些數據表（400k行，這就是爲什麼我用很長的變量，而不是整數），我想檢查列R（包含ID），需要檢查列S和T.如果R是相同的，並且S和T不同，則代碼應該複製整行並將其粘貼到另一個表中。代碼運行並粘貼一些東西，但不是正確的行。在此先感謝，任何幫助將不勝感激。

樣本數據

R   S  T 
1234 Kevin Smith 
2345 John Miller 
1234 Carl Jones 
1234 Kevin Smith 
4567 Mike Redwood 
2058 William Wales

代碼

Sub mySub1() 
    Set wb = ThisWorkbook 
    Set tbl = wb.Sheets("sheet1") 
    Dim lrow As Long 
    Dim i As Long 
    Dim x As Long 
    Dim y As Long 
    Dim cell As Range 

    i = 1 
    x = 0 
    y = 1 

    Sheets("sheet1").Activate 

    lrow = tbl.Cells(Rows.Count, "A").End(xlUp).Row 

    For Each cell In Range("R2:R" & lrow) 
     If cell.Offset(x, 0).Value = cell.Offset(i, 0).Value And _ 
     cell.Offset(0, 1) <> cell.Offset(i, 1).Value And _ 
     cell.Offset(0, 2).Value <> cell.Offset(i, 2).Value Then 
      ActiveSheet.Range(Cells(i + 1, 1), Cells(i + 1, 26)).Select 
      Selection.Copy 
      Sheets("sheet2").Select 
      ActiveSheet.Cells(y, 1).PasteSpecial 
      y = y + 1 
     End If 
     Sheets("sheet1").Activate 
     i = i + 1 
     x = x + 1 
    Next 
End Sub

來源

2013-12-11 DEFCON123

那麼，哪一行正在被複制 - 下一行？ – Chris

[有趣的閱讀]（http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select）也可以發佈樣本數據，以便我可以在發佈解決方案之前測試代碼？ –

理想情況下，其中包含默認值和下一個值的初始行。這個想法是找出列R中具有相同ID但S和T中不同值的每一行。 – DEFCON123

好吧，我嘗試了400K行不同的方法。這是我發現最快的一個。

邏輯：

的數據複製到一個臨時表，然後刪除重複。
排序數據
存儲所產生的範圍內，在陣列
環路，做比賽，最後複製

我假設在Sheet1數據沒有頭。如果確實如此，則將Header:=xlNo更改爲Header:=xlYes並修改for循環。

IMP：由於行數的原因，不能使用Autofilter或工作表函數Countif。

代碼：

Sub Sample() 
    Dim wsI As Worksheet, wsO As Worksheet, wsTemp As Worksheet 
    Dim wsILRow As Long, wsOLRow As Long 
    Dim rng As Range 
    Dim itm As String 
    Dim Myar 

    Set wsI = ThisWorkbook.Sheets("Sheet1") 
    Set wsO = ThisWorkbook.Sheets("Sheet2") 
    Set wsTemp = ThisWorkbook.Sheets.Add 

    wsOLRow = wsO.Range("A" & wsO.Rows.Count).End(xlUp).Row + 1 

    wsI.Cells.Copy wsTemp.Cells 

    With wsTemp 
     wsILRow = .Range("R" & .Rows.Count).End(xlUp).Row 

     .Range("$R$1:$T$" & wsILRow).RemoveDuplicates Columns:=Array(1, 2, 3), _ 
     Header:=xlNo 

     .Columns("A:Z").Sort Key1:=.Range("R1"), Order1:=xlAscending, Header:=xlNo, _ 
     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
     DataOption1:=xlSortNormal 

     wsILRow = .Range("R" & .Rows.Count).End(xlUp).Row 

     Set rng = .Range("R1:T" & wsILRow) 
    End With 

    Myar = rng.Value 

    For i = 1 To UBound(Myar) 

     If i > 1 Then If Myar(i, 1) = Myar(i - 1, 1) Then GoTo NextRec 

     itm = Myar(i, 1) 
     For j = i + 1 To UBound(Myar) 
      If Myar(j, 1) = itm Then 
       If Myar(i, 2) & Myar(j, 2) <> Myar(i, 3) & Myar(j, 3) Then 
        wsTemp.Rows(j).Copy wsO.Rows(wsOLRow) 
        wsOLRow = wsOLRow + 1 
       End If 
      End If 
     Next j 
NextRec: 
    Next i 

    Application.DisplayAlerts = False 
    wsTemp.Delete 
    Application.DisplayAlerts = True 
End Sub

來源

2013-12-11 17:39:19

對不起，遲到的迴應。感謝Siddarth，它像一個魅力！我假設你沒有在400k行上運行代碼？！你能估計需要花多少時間來循環整張紙嗎？如果sheet1中的數據具有標題，那麼我需要在For循環中更改哪些內容？將我設置爲0？ – DEFCON123

我的確在400k行上運行過，因此我花了很長時間才發佈。雖然Autofilter/Countif/Union花了很多時間，但速度相對較快。我沒有示例文件了。但正如我所說，這是最快的。 –

我也跑了它，Excel沒有反應。大約20分鐘後，我剛剛退出Excel並將原始數據拆分成大約30-50k行的小塊。您是否花了20分鐘以上才能運行整個代碼？ – DEFCON123

如果你沒有使用VBA，你可以用簡單的操作工作做到這一點。

採取工作表：

追加含有增加行數列，
分類ID（欄R），和行數，
追加式=AND(R2=R1,OR(S2<>S1,T2<>T1))到行2和將其複製到工作表中，
過濾器顯示所有的行是真實的，並且
將可見行復制到新工作表。

這應該會給你更好的性能並且更容易維護。

來源

2013-12-11 18:30:12 Pekka

回答

相關問題