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

【问题标题】：Compare two columns in Excel and insert a new row比较 Excel 中的两列并插入新行
【发布时间】：2019-10-30 11:12:59
【问题描述】：

我在 Excel vba 上玩得很开心（很糟糕）。

我在工作簿中有两张工作表 - sheet1 和 sheet2。

表 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 列的行以找出已添加到 sheet2 但不在 sheet1 中的新 accountNo。如果找到AccountNO，我想将它插入到sheet1中，它必须插入到sheet1中的最佳位置，因为帐号是按顺序排列的。示例是 110103 accountNO，我想在 sheet1 中的 110102 account no 之后插入整行。

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。

【问题讨论】：

最后一行是做什么的？为什么不直接在表格 1 的底部插入新行，然后在末尾按 a/c no 排序？
如果工作表 2 总是比工作表 1 多或相同，只需复制前者？
听起来你让这变得比必要的更困难 - 如果 sheet2 的行数比 sheet1 的多，请复制工作表 2 中的 who 列并替换工作表 1 中的列 1。
sheet1 链接到其他一些工作表，需要这些值的位置。（我不知道如何通过打字来表达）。 sheet1 通常有一些旧的帐号，它们在 sheet2 中不再需要，但在其他一些工作表中需要。

标签： excel vba excel-2010

【解决方案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

【讨论】：

如何复制和覆盖这些值。
Worksheets("Sheet2").Range("A1:B200").Copy: Worksheets("Sheet1").Range("A1:B200").PasteSpecial xlPasteValues，例如。将其添加到答案中，@josephnkoro。
谢谢，这有助于使用 sheet2 中新发现的 accountNO 更新 sheet1。我想更新 sheet1 中已经存在的 accountNos 的值，这可行吗？
我认为@AhmedAbdelhameed 已经回答了您的问题。如果您需要更多帮助，请开始一个新问题。另外，不要忘记接受这个作为您的答案，因为它符合您原始问题的要求

【解决方案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

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

【讨论】：