比较Excel中的两列并插入新行

Question

我用Excel vba玩得很开心(不开心(。

我有两张工作薄——第一张和第二张。

第1张

AccountNo   Account Name    
110101      Imprest        
110102      abs        
110104      abs - Call  
110105      abc-MANAGED 
110109      bda - Dollar    
110201      jhk - Dollar    

第2张

AccountNo   Account Name    
110101      Imprest        
110102      abs
110103      bas 
110104      abs - Call  
110105      abc-MANAGED 
110109      bda - Dollar    
110201      jhk - Dollar    

我想比较行和AccountNo列，找出已经添加到表2中但没有添加到表1中的新AccountNo。如果找到了AccountNO，我想将其插入到表1中，并且必须将其插入表1中的最佳位置，因为帐号是按顺序排列的。例如110103 accountNO，我想在表1中110102 accountNO之后插入整行。

Dim rngCell As Range
Dim matchRow
For Each rngCell In Worksheets("Sheet2").Range("A2:A200")
If WorksheetFunction.CountIf(Worksheets("Sheet1").Range("A2:A200"), rngCell) = 0 Then
' Range("K" & Rows.Count).End(xlUp).Offset(1) = rngCell
matchRow = rngCell.Row
Rows(matchRow & ":" & matchRow).Select
rngCell.EntireRow.Copy
Range("K" & Rows.Count).PasteSpecial xlPasteValues
End If
Next

代码似乎没有帮助。仅能够识别新的accountNO。

Answer 1

如果两张表中的帐号实际上是按顺序排列的，那么就不需要使用CountIf。您可以简单地迭代Sheet2的行，并将它们的帐号与Sheet1中相同位置的帐号进行比较。如果在Sheet1中找不到匹配项，则在该位置插入一行。

试试这样的东西：

Sub Test()
Dim sourceCell As Range, targetCell As Range
Dim i As Integer
For i = 2 To 200
Set sourceCell = Worksheets("Sheet2").Range("A" & i)
Set targetCell = Worksheets("Sheet1").Range("A" & i)
If targetCell.Value <> sourceCell.Value Then
sourceCell.EntireRow.Copy
targetCell.EntireRow.Insert
targetCell.Offset(-1, 0).EntireRow.PasteSpecial xlPasteValues
End If
Next
End Sub

注意：这假设您不想覆盖Sheet1中的现有值，否则，您可以复制Sheet2的所有行并将它们粘贴到Sheet1中。例如：

Worksheets("Sheet2").Range("A1:B200").Copy
Worksheets("Sheet1").Range("A1:B200").PasteSpecial xlPasteValues

Answer 2

如果您想更接近原始代码，您尝试的方法并非不可能。你只需要从第二张纸上复制一行，并将其插入到你复制的同一行：

Sub match()
Dim rngCell As Range
Dim matchRow As Integer, nextcol As Integer
For Each rngCell In Worksheets("Sheet2").Range("A2:A200")
If rngCell <> "" Then
If WorksheetFunction.CountIf(Worksheets("Sheet1").Range("A2:A200"), rngCell) = 0 Then
Sheet2.Range(Sheet2.Cells(rngCell.Row, 1), Sheet2.Cells(rngCell.Row, Columns.Count).End(xlToLeft)).Copy
Sheet1.Range("A" & rngCell.Row).Insert
End If
End If
Next
End Sub

注意，我在复制量中放了一个列计数器，这可以防止您复制整行，如果您有很多点击，这可能会加快代码的速度。