質問

ユーザーが入力した 2 つのワークシートを比較し、異なる理由に応じて相違点を別のシートに移動するマクロを作成しようとしています。

コードは最初に最新データの入力を要求し、そのシートを開きます。次に、比較する古いデータの場所を尋ねますが、そのデータは開きません。コピー先として必要なシートを追加します。

次に、セルごとに列を下って 2 番目のブックで一致するシリアル番号を探します (これは主に、大文字と小文字の書式設定がオフになっている場合に正しいデータを比較することを保証するためです)。一致するシリアルを見つけると、両方のエントリの 2 番目のシリアルを比較し、シートの 1 つへの入力が異なるか新しいかに応じて比較します。

私が抱えている主な問題は VLookup に関するものです。複数のエラー 424、1004、およびコンパイル式エラーが発生しています。なぜこのような問題が発生するのかについて少しガイダンスが必要です。ファイルを参照するために括弧が必要であることについて検索して多くのことを見つけましたが、これらの形式に正確に従うと式エラーがスローされます。

アドバイスをいただければ幸いです。

Sub Compare()

'Open workbooks
''Worksheet 1

Dim filter As String
Dim caption As String
Dim WB1FN As String
Dim WB1 As Workbook

filter = "Excel Sheets (*.xlsx),*.xlsx"
caption = "Please select newest equipment file"
MsgBox (caption)
WB1FN = Application.GetOpenFilename(filter, , caption)

        If WB1FN = "False" Then
            MsgBox "File not selected to import"
            Exit Sub
        End If

Set WB1 = Application.Workbooks.Open(WB1FN)

''Worksheet 2

Dim caption2 As String
Dim WB2FN As String

filter = "Excel Sheets (*.xlsx),*.xlsx"
caption2 = "Please select previous equipment file"
MsgBox (caption2)
WB2FN = Application.GetOpenFilename(filter, , caption)

        If WB2FN = "False" Then
            MsgBox "File not selected to import"
            Exit Sub
        End If

'Comparing data
''MS find and compare

Dim MS1 As String
Dim ESN1 As String
Dim ESN2 As String
Dim LastRow As Long
Dim i As Integer
Dim d As Integer
Dim n As Integer
Dim Filename As String

d = 4
n = 4

Set WB1 = ActiveWorkbook

'Create sheets

Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "A"
Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "B"
Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "C"

'Gets the last row number

ActiveWorkbook.Sheets(1).Activate
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

For i = 4 To LastRow

''Assigning MS1,ES1,ES2

    MS1 = Cells(i, 6)
    ESN1 = Cells(i, 15)
    ESN2 = Application.WorksheetFunction.VLookup(MS1, '[" & WB2FN & "]Sheet1'! [R3C6:R10000C15], 10, False)
''Compare ESN and copy data

        If ESN2 <> ESN1 Then
        cell.EntireRow.Copy Sheets(2).Cells(d, 1)
        n = d + 1
        ElseIf Application.WorksheetFunction.IsNA(ESN2) = "TRUE" Then
        cell.EntireRow.Copy Sheets(4).Cells(n, 1)
        n = n + 1
        End If
Next i

'X find and copy

Dim OEM As String

ActiveWorkbook.Sheets(2).Activate

LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

n = 3
i = 3

For i = 3 To LastRow

''Check for X

    OEM = Cells(i, 4)

    If OEM = "x" Then
        cell.EntireRow.Copy Sheets(3).Cells(n, 1)
        n = n + 1
    End If

Next i

MsgBox "Compare successful"

End Sub
役に立ちましたか?

解決

have brackets to reference a file この方法は、数式をセルまたは範囲に割り当てる場合にのみ使用できます。

例:

Dim myformula As String

myformula = "=VLOOKUP(" & MS1 & _
    ",'[" & WB2FN & "]Sheet1'! [R3C6:R10000C15], 10, False)"
Range("A1").Formula = myformula

しかし、使用する場合は、 VBA ワークシート関数, 、実行時にデータを取得するデータベースまたはテーブルに何らかの方法でアクセスする必要があります。つまり、上記のように文字列ではなく、引数でオブジェクトを渡す必要があります。
何かのようなもの:

'~~> the rest of your code before Vlookup here

Dim wb As Workbook
Dim mytable As Range

Set wb = Workbooks.Open(WN2FN, , True) '~~> read only, avoid errors when file in use
Set mytable = wb.Sheets("Sheet1").Range("F3:O10000")

On Error Resume Next '~~> to handle when Vlookup returns #N/A or errors out
ESN2 = Application.WorksheetFunction.VLookup(MS1, mytable, 5, 0)
If Err.Number <> 0 Then myvalue = CVErr(xlErrNA)
On Error GoTo 0 '~~> reset error handling to trap other errors

Debug.Print ESN2

を使用する部分を提供しただけです Vlookup ワークシート関数. 。その前にコードの残りの部分を使用できます。基本的に上記のコード:

  • ソーステーブルを変数に代入し、それを直接渡します Vlookup 引数。
  • 用途 Vlookup 経由 VBA ワークシート関数 データを取得します。

OERN に注意してください (エラー時は次へ再開) ルーチンと OEG0 (エラー時は0に移動).
VBA では、 ワークシート関数 エラーを返します (例:#Vlookup の場合は N/A)、コードがエラーとなり、実行が停止します。ありません イフェラー ワークシートの数式の場合と同様です。したがって、エラー処理ルーチンを使用して処理する必要があります。

また、作業しているオブジェクトを完全に修飾することをお勧めします。
これは、コードの最適化を開始し、実行時エラーを回避するのに適した場所です。

ライセンス: CC-BY-SA帰属
所属していません StackOverflow
scroll top