VBA マクロの作成に関する問題について、助けていただければ幸いです。2 つのワークブックがあり、ワークブック 1 の列 "N" とワークブック 2 の列 "F" を比較したいと考えています。一致するものがあれば次のセルに移動し、一致が見つからなければワークブック 2 の列 "F" の次のセルをコピーしたいと考えています。ワークブック 2 は毎朝取得するときに同じ名前にはなりませんが、ワークブック名は常に "Copy of" で始まるため、部分的な名前を使用して選択するための以下のコードを作成しました。
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 つのワークブック (ファイル) を参照しています
が、コードはワークシート (同じワークブック内のタブ) を参照しています。