VBA比较两个工作表中的行并添加缺失的数据答案

【问题标题】：VBA Compare rows in two worksheets and add missing dataVBA比较两个工作表中的行并添加缺失的数据
【发布时间】：2020-08-03 11:49:25
【问题描述】：

我想比较存储在两个不同工作簿中的两个确切工作表。

我希望第一张表中的数据（参见蓝色 ID - KDws 列）出现在第二张表（绿色 ID - KDwsMain）中，这是主文件。不希望重复项显示在主文件中。

有什么想法可以改进下面的代码吗？

我的一段代码：

Sub CompareKDandDetailsView()

Dim wb As Workbook
Dim wbMain As Workbook
Set wb = ActiveWorkbook
Dim LastR As Long, LastR_main As Long
Dim i As Integer, k As Integer, j As Integer

Dim KDws As Worksheet, KDwsMain As Worksheet
Dim strFile As String
  
Set KDws = wb.Worksheets("KD")
LastR = KDws.Cells(Rows.Count, 1).End(xlUp).Row

'open Target file
MsgBox "Select the main file to upload your changes."
strFile = Application.GetOpenFilename()
Workbooks.Open (strFile)

Set KDwsMain = wbMain.Worksheets("KD")
LastR_main = KDwsMain.Cells(Rows.Count, 1).End(xlUp).Row
'-----------------------------

'-----------------------------
k = KDwsMain.UsedRange.Rows.Count 'last used row of the first worksheet
j = KDws.UsedRange.Rows.Count 'last used row of the second worksheet

For i = 2 To k 'Loop through the used rows of the first worksheet
    'use "countIf" to quickly check if the value exists in the given range
    'This way we don't have to loop through the second worksheet each time
     If Application.WorksheetFunction.CountIf(KDwsMain.Range(KDwsMain.Cells(2, 1), KDwsMain.Cells(j, 1)), KDws.Cells(i, 1).Value) > 0 Then
        'do nothing
    Else
        LastR_main = KDwsMain.Cells(Rows.Count, 1).End(xlUp).Row
        KDwsMain.Cells(LastR_main + 1, 1).Value = KDws.Cells(i, 1)
        KDwsMain.Cells(LastR_main + 1, 2).Value = KDws.Cells(i, 2)
    End If
Next i

End Sub

【问题讨论】：

如果您说可能存在重复，“精确工作表”是什么意思？您是否只想对 A:A 列进行处理，或者 A:A 应该被视为对两张表的引用，并且处理将在具有相同引用的行上完成？其中哪个是“主文件”？我的意思是，看着你的照片。如果它们必须具有某种相关性...
因此，如果在第二个工作簿中找不到 A:A 第一个工作簿中的值，您希望在第二个工作表的第一个空行中添加第一个工作簿的 A:B 范围的值一。这种理解正确吗？
所以我有两个工作表 - 在代码中是 KDws 和 KDwsMain。我希望 KDwsMain 表包含 KDws 表中的所有 ID。因此，如果您遍历 KDws 行，我们感兴趣的第一个是基本工资（在屏幕截图中），我希望将其粘贴到 KDwsMain 表中的最后一个可用行。
要粘贴的行是否多于两列？我只能在您的代码中看到两个...
是的 - 它有 12 列

标签： vba for-loop compare

【解决方案1】：

请尝试下一个代码。未经测试，但我认为它应该可以工作：

Sub CompareKDandDetailsView()
Dim wb As Workbook, wbMain As Workbook

Set wb = ActiveWorkbook
Dim LastR As Long, LastR_main As Long, lastCol As Long
Dim i As Long

Dim KDws As Worksheet, KDwsMain As Worksheet
Dim strFile As String
  
Set KDws = wb.Worksheets("KD")
LastR = KDws.cells(Rows.count, 1).End(xlUp).Row
lastCol = KDws.cells(1, Columns.count).End(xlToLeft).Column
'open Target file
MsgBox "Select the main file to upload your changes."
strFile = Application.GetOpenFilename()
Set wbMain = Workbooks.Open(strFile)

Set KDwsMain = wbMain.Worksheets("KD")
'-----------------------------

 For i = 2 To LastR 'Loop through the used rows of the first worksheet
    'use "countIf" to quickly check if the value exists in the given range
    'This way we don't have to loop through the second worksheet each time
     LastR_main = KDwsMain.cells(Rows.count, 1).End(xlUp).Row + 1
     If Application.WorksheetFunction.CountIf(KDwsMain.Range("A2:A" & LastR_main), _
                                                       KDws.Range("A" & i)) = 0 Then

        KDwsMain.Range(KDwsMain.cells(LastR_main, "A"), KDwsMain.cells(LastR_main, lastCol)).Value = _
                                            KDws.Range(KDws.cells(i, 1), KDws.cells(i, lastCol)).Value
    End If
 Next i
End Sub

【讨论】：