VBA 매크로를 만들 때 발생하는 문제에 대해 도움을 받을 수 있다면 감사하겠습니다. 두 개의 통합 문서가 있고 통합 문서 1의 "N" 열을 통합 문서 2의 "F" 열과 비교하고 싶습니다. 그런 다음 일치하는 항목이 있으면 다음 셀로 이동하고 일치하는 항목이 없으면 열 뒤의 다음 셀을 복사하고 싶습니다. 통합 문서 2의 "F". 통합 문서 2는 매일 아침 받을 때 이름이 동일하지 않지만 통합 문서 이름은 항상 "사본"으로 시작하므로 부분 이름을 사용하여 선택하도록 아래 코드를 만들었습니다.
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "Copy of*" Then
ws.Select
Exit For
End If
Next ws
내가 올바른 방향을 가리킬 수 있다면 정말 좋을 것입니다.
답변1
이 설명은 그다지 명확하지 않습니다
...일치하는 항목이 있으면 아래의 다음 셀로 이동합니다. 일치하는 항목이 없으면 통합 문서 2의 "F" 열 다음 셀을 복사하고 싶습니다...
하지만 이와 같은 것을 시도하고 그에 따라 수정하십시오.
Option Explicit
Public Sub CompareWorkBooks()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = GetWSCopy("Copy of*")
If Not ws2 Is Nothing Then
Dim r As Long, cel As Range, found As Variant, ws2lr As Long
optimizeXL True
For r = ws1.UsedRange.Rows.Count To 1 Step -1
Set cel = ws1.Cells(r, ws1.Columns("N").Column)
If Len(cel.Value2) > 0 Then
found = Application.Match(cel.Value2, ws2.UsedRange.Columns("F"), 0)
If Not IsError(found) Then 'a match was found so move next cell down
cel.Offset(1).EntireRow.Insert xlDown
Else 'match not found so copy row from ws1 to first empty row of ws2
ws2lr = ws2.UsedRange.Rows.Count + 1
ws1.UsedRange.Rows(cel.Row).EntireRow.Copy ws2.Cells(ws2lr, 1)
End If
End If
Next
optimizeXL False
End If
End Sub
Private Function GetWSCopy(ByVal wsName As String) As Worksheet
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like wsName Then
Set GetWSCopy = ws
Exit Function
End If
Next
End Function
Public Sub optimizeXL(Optional ByVal settingsOff As Boolean = True)
With Application
.ScreenUpdating = Not settingsOff
.Calculation = IIf(settingsOff, xlCalculationManual, xlCalculationAutomatic)
.EnableEvents = Not settingsOff
End With
End Sub
또한 2개의 통합 문서(파일)를 참조하고 있지만
코드는 워크시트(동일한 통합 문서 내의 탭)를 참조하고 있습니다.