Question

我正在编写一个宏来比较第一个文件中的一列到另一个文件中的一列的值。如果未找到其他文件中的值，则宏应插入一行，然后复制缺少的值。目前我遇到问题，因为调试器显示应用程序或对象定义的错误。任何想法可能是什么问题？

我目前的代码是：

Sub CheckC()
Dim i As Integer
Dim sh1 As Variant
Dim sh2 As Variant
i = 6

sh1 = Application.Workbooks("workbookc.xlsx").Worksheets("sheet name").Range(Cells(6, 3), Cells(6, 3).End(xlDown)).Value
sh2 = Application.Workbooks("workbookm.xlsm").Worksheets("Sheet1").Range(Cells(6, 3), Cells(6, 3).End(xlDown)).Value

For Each val_sh1 In sh1
    flag = False
    For Each val_sh2 In sh2
        i = i + 1
        If val_sh1 = val_sh2 Then
            flag = True
            Exit For
        End If
    Next val_sh2
    If flag = False Then

    Workbooks("workbookm.xlsm").Worksheets("Sheet1").Range(Cells(i, 1), Cells(i, 9)).Select
    Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
    Workbooks("workbookc.xlsx").Worksheets("sheet name").Range(Cells(i, 1), Cells(i, 9)).Copy Destination:=Workbooks("workbookm.xlsm").Worksheets("Sheet1").Range(Cells(i, 1), Cells(i, 9))

    End If

Next val_sh1

End Sub

修改更新：谢谢大家的答案，我已经提出了一些解决方案，使用你的建议。最终代码如下所示：

 Sub CheckC()
 Dim i As Long
 Dim ws1 As Excel.Worksheet
 Set ws1 = Workbooks("workbookc.xlsx").Worksheets("sheet name")
 Dim ws2 As Excel.Worksheet
 Set ws2 = Workbooks("workbookm.xlsm").Worksheets("Sheet1")
 Dim sh1 As Range
 Dim sh2 As Range
 i = 5
 counter = 0
 ws1.Activate
 Set sh1 = ws1.Range(Cells(6, 3), Cells(6, 3).End(xlDown))
 ws2.Activate
 Set sh2 = ws2.Range(Cells(6, 3), Cells(6, 3).End(xlDown))

 For Each val_sh1 In sh1
   flag = False
   i = i + 1
   For Each val_sh2 In sh2

        If val_sh1 = val_sh2 Then
            flag = True
            Exit For
        End If
    Next val_sh2
    If flag = False Then

    ws2.Range(Cells(i, 1), Cells(i, 9)).Select
    Selection.Insert Shift:=xlDown
    ws1.Activate
    ws1.Range(Cells(i, 1), Cells(i, 9)).Select
    Selection.Copy
    ws2.Activate
    ws2.Range(Cells(i, 1), Cells(i, 9)).Select
    ActiveSheet.Paste
    counter = counter + 1
    End If

Next val_sh1

MsgBox counter & " new rows were added to workbookm"
ws2.Activate
Range("A1").Value = "workbookm updated on " &      Now()
End Sub

它正常运作。

Answer 1

SCB正确地说你的sh1和sh2变量存在问题。一般来说，您应该将整个事物拆分为更多定义工作簿，工作表和范围级别的变量，然后您可以引用范围级别的值。如果正确定义，则无需在循环时激活工作簿，而是直接引用这些工作簿中的数据。

请参阅以下我所获得的代码示例。它并不完全符合您的要求，但它应该是您修改它以满足您需求的充分基础。它将wkb2列A的值与wkb1的列A中的值进行比较，如果有任何缺失值，它会将它们附加到wkb1的A列末尾。您可以在列A中创建两个包含一些数据的测试文件，将下面的宏复制到将分配给wkb2的宏中并运行以查看它的作用。我希望它会帮助你。

Sub compareTwoColumns()

'Define starting row and column
Dim r As Integer, c As Integer
r = 2
c = 1

'Define workbooks
Dim wkb1 As Excel.Workbook
Dim wkb2 As Excel.Workbook
'wkb2 should be the workbook that holds this macro
Set wkb2 = Application.Workbooks("testWKB2.xlsm")
Set wkb1 = Application.Workbooks.Open("C:\TEMP\testWKB1.xlsx", ReadOnly:=False)

'Define variables for worksheets
Dim sh1 As Excel.Worksheet
Dim sh2 As Excel.Worksheet
Set sh1 = wkb1.Worksheets("Sheet1")
Set sh2 = wkb2.Worksheets("fnd")

'Define ranges
Dim rng1 As Range, rng2 As Range
Set rng1 = sh1.Range(Cells(r, c), Cells(r, c).End(xlDown))
wkb2.Activate
sh2.Activate
Set rng2 = sh2.Range(Cells(r, c), Cells(r, c).End(xlDown))

Dim list1 As New Collection
Dim found As Boolean

Application.ScreenUpdating = False

For Each i In rng2

    found = False

    For Each j In rng1
        If j.Value = i.Value Then
            found = True
            Exit For
        End If
    Next j

    If Not found Then
            list1.Add (i.Value)
    End If

Next i

Dim string1 As String
For Each n In list1
    string1 = string1 & Chr(13) & n
Next n

Application.ScreenUpdating = True

'Inserting missing rows

If list1.Count > 0 Then

    MsgBox "The following rows will be inserted: " & Chr(13) & string1

    'Activate target worksheet and activate the last cell in column A
    sh1.Activate
    Range("A1").End(xlDown).Activate

    'Add missing rows at the bottom of the column
    For Each m In list1
        ActiveCell.Offset(1, 0).Activate
        ActiveCell.Value = CStr(m)
    Next m
Else
    MsgBox "No missing rows found"
End If

End Sub

VBA宏来比较2个文件

1 个答案: