VBA 매크로 2 파일 비교

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 변수에 있다고 말하면서 옳습니다. 일반적으로 통합 문서, 워크 시트 및 범위 수준을 정의하는 변수로 전체를 분할해야합니다. 그런 다음 범위 수준의 값을 참조 할 수 있습니다. 올바르게 정의하면 반복 할 때 통합 문서를 활성화 할 필요가 없으며 해당 통합 문서의 데이터를 직접 참조합니다.

내가 가진 코드의 아래 예제를 참조하십시오. 그것은 당신이 찾고있는 것과 정확히 일치하지 않지만, 당신의 요구에 맞게 수정할 수있는 충분한 근거가되어야합니다. wkb1의 열 A의 값과 wkb2의 열 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