首页 > 解决方案 > VBA比较两个工作表中的行并添加缺失的数据

问题描述

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

我希望第一张表中的数据(参见蓝色 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

标签: vbafor-loopcompare

解决方案


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

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

推荐阅读