excel - VBA ルックアップ - WorkSheet 関数クラスの Vlookup プロパティを取得できません

Question

同様の問題がすでにここで議論されていることを知っています: VBA の VLookup が実行時エラー 1004 で失敗するのはなぜですか?

しかし、私の問題を解決していないようです。ここでやりたいことの簡単な説明 - これは私の最初の VBA 投稿なので、質問の明確さなどに問題がある場合はお知らせください。

に基づいて請求書を作成する請求書シートを作成しようとしています

プロジェクト番号 (この場合は 1)
全プロジェクトデータのデータセット

各プロジェクト活動は個別の項目として表示され、プロジェクト番号と項目番号で構成される一意の識別子によって識別されます (したがって、プロジェクト 1 の 3 番目の項目の場合は「1/3」になります)。識別子は文字列としてフォーマットされます。すべての入力データは、「入力」と呼ばれるワークシートにあります。

2 番目のシートは、「請求書」と呼ばれる実際の請求書シートです。アイデアは、各プロジェクトの項目数に応じて適切な数の空白行を自動的に取得し (まだこの部分で作業中です)、フォームに自動的に入力することです。vlookupこの最後の部分は、 80 行目で実行しようとしたときにエラーが発生する部分です。エラーメッセージは次のとおりです。

WorksheetFunction クラスの Vlookup プロパティを取得できません。

適切に作成していないため、ルックアップ値 (識別子) が原因かどうか疑問に思っています。ここでこれまでに説明した解決策を見てきましたが、答えを見つけることができません:(

よろしくお願いします。以下のコード:

Option Explicit

Sub Count_Line_Items()

'Counts the number of line items of a consulting project to determine the space needed on the invoice form

     Dim Cell As Range
     Dim PosCnt As Integer
     Dim ServCnt As Integer
     Dim ExpCnt As Integer

     PosCnt = 0
     ServCnt = 0
     ExpCnt = 0

    'Counting all project positions for the chosen project number
    For Each Cell In Range("ProjectList")
       If Cell.Value = Range("IdSelect") Then
           PosCnt = PosCnt + 1
        End If
    Next Cell

    MsgBox "Total number of line items: " & PosCnt

    'Counting all positions of that project that are consulting services
    For Each Cell In Range("ProjectList")
       If Cell.Value = Range("IdSelect").Value And Cell.Offset(0, 3).Value = "Service" Then
        ServCnt = ServCnt + 1
       End If
    Next Cell

    MsgBox "Total number of consulting services: " & ServCnt

    'Calculating number of expense items
    ExpCnt = PosCnt - ServCnt

    MsgBox "Total number of expenses: " & ExpCnt

End Sub

Sub Count_Total_Rows()

    Dim Current_RowCnt As Integer
    Dim Target_RowCnt As Integer
    Dim Diff_Rows As Integer

    Target_RowCnt = 62

    'Counting the rows in the print area and calculating difference to target
    Range("Print_Area").Select
    Current_RowCnt = Selection.Rows.Count
    Diff_Rows = Target_RowCnt - Current_RowCnt
        If Diff_Rows > 0 Then
            MsgBox "We need to add " & Diff_Rows & " rows!"
        ElseIf Diff_Rows < 0 Then
            MsgBox "We need to delete " & -Diff_Rows & " rows!"
        Else
            MsgBox "Nothing needs to be done; all good!"
        End If
End Sub

Sub Write_Services()
'Looks up services on data sheet and writes them to invoice sheet
    Dim Cnt As Integer
    Dim ServCnt As Integer
    Dim PosIdent As String
    Dim Data As Range

    Cnt = 0
    'Building position identifier
    PosIdent = "IdSelect" & "/" & Cnt + 1
    Sheets("Input").Select
    ActiveSheet.Range("D26:AD151").Select
    Set Data = Selection

    Sheets("Invoice").Select
    ActiveSheet.Range("Service_Title").Offset(1, 0).Activate
    'There is still an issue with the counter (line number won't increment by 1 if cnt range is incremented by 1
    For Cnt = 0 To ServCnt + 1
        ActiveCell.Value = Application.WorksheetFunction.VLookup(PosIdent, Data, 15, False)
        ActiveCell.Offset(1, 0).Activate
        Cnt = Cnt + 1
    Next Cnt
End Sub

更新:最後の手順のコードを次のように変更しました。

Sub Write_Services()
'Looks up services on data sheet and writes them to invoice sheet
Dim Cnt As Integer
Dim ServCnt As Integer
Dim PosIdent As String
Dim Data As Range

Cnt = 0
'Building position identifier

Sheets("Input").Select
ActiveSheet.Range("D26:AD151").Select
Set Data = Selection

Sheets("Invoice").Select
ActiveSheet.Range("Service_Title").Offset(1, 0).Activate
'There is still an issue with the counter (line number won't increment by 1 if cnt range is incremented by 1
For Cnt = 0 To ServCnt + 1
    PosIdent = Range("IdSelect").Value & "/" & Cnt + 1
    ActiveCell.Value = Application.WorksheetFunction.VLookup(PosIdent, Data, 15, False)
    ActiveCell.Offset(1, 0).Activate
    Cnt = Cnt + 1
Next Cnt
End Sub

ただし、エラーメッセージは同じままです。コードの改善に感謝します (ループによって PosIdent が更新されなかったという問題は修正されました) - 他のアイデアはありますか?

更新番号 2:

これまでに受け取った役立つ回答/コメントに基づいてコードを更新しました (大きな感謝です!)。新しいエラーメッセージが作成されます (新しいエラーメッセージが以前のコードで発生したため、古いエラーメッセージが解決されたかどうかはわかりません)。行 59)。新しいエラーは「1004: オブジェクト '_GLobal' のメソッド 'Range' が失敗しました。他のすべてを呼び出す新しいサブルーチンを作成したばかりなので、何がトリガーされたのか本当にわかりません。最後にMain変数ServCntを引数として渡しました。 sub. 誰か助けてくれませんか?

以下の新しいコード:

Option Explicit



Sub Main()

Dim ServCnt As Integer

Call Count_Line_Items
Call Count_Total_Rows
Call Write_Services(ServCnt)

End Sub

Sub Count_Line_Items()

'Counts the number of line items of a consulting project to determine the space needed on the invoice form

 Dim Cell As Range
 Dim PosCnt As Integer
 Dim ServCnt As Integer
 Dim ExpCnt As Integer

 PosCnt = 0
 ServCnt = 0
 ExpCnt = 0

'Counting all project positions for the chosen project number
For Each Cell In Range("ProjectList")
   If Cell.Value = Range("IdSelect") Then
       PosCnt = PosCnt + 1
    End If
Next Cell

MsgBox "Total number of line items: " & PosCnt

'Counting all positions of that project that are consulting services
For Each Cell In Range("ProjectList")
   If Cell.Value = Range("IdSelect").Value And Cell.Offset(0, 3).Value = "Service" Then
    ServCnt = ServCnt + 1
   End If
Next Cell

MsgBox "Total number of consulting services: " & ServCnt

'Calculating number of expense items
ExpCnt = PosCnt - ServCnt

MsgBox "Total number of expenses: " & ExpCnt


End Sub

Sub Count_Total_Rows()

Dim Current_RowCnt As Integer
Dim Target_RowCnt As Integer
Dim Diff_Rows As Integer

Target_RowCnt = 62

'Counting the rows in the print area and calculating difference to target
Range("Print_Area").Select
Current_RowCnt = Selection.Rows.Count
Diff_Rows = Target_RowCnt - Current_RowCnt
    If Diff_Rows > 0 Then
        MsgBox "We need to add " & Diff_Rows & " rows!"
    ElseIf Diff_Rows < 0 Then
        MsgBox "We need to delete " & -Diff_Rows & " rows!"
    Else
        MsgBox "Nothing needs to be done; all good!"
    End If


End Sub

Sub Write_Services(ServCnt)
'Looks up services on data sheet and writes them to invoice sheet
    Dim Cnt As Integer
    Dim PosIdent As String
    Dim Data As Range

Cnt = 0
'Building position identifier

Sheets("Input").Select
ActiveSheet.Range("D26:AD151").Select
Set Data = Selection
PosIdent = Range("IdSelect").Value & "/" & Cnt + 1

Sheets("Invoice").Select
ActiveSheet.Range("Service_Title").Offset(1, 0).Activate
'There is still an issue with the counter (line number won't increment by 1 if cnt range is incremented by 1
For Cnt = 0 To ServCnt + 1
    ActiveCell.Value = Application.WorksheetFunction.VLookup(PosIdent, Data, 15, False)
    ActiveCell.Offset(1, 0).Activate
    Cnt = Cnt + 1
Next Cnt

End Sub

更新 3:

最後のバグを修正 - 詳細については、以下のコメントを参照してください。以下の作業コード：

Option Explicit Public ServCnt As Integer



Sub Main()

Call Count_Line_Items
Call Count_Total_Rows
Call Write_Services(ServCnt)

End Sub

Sub Count_Line_Items()

'Counts the number of line items of a consulting project to determine the space needed on the invoice form

 Dim Cell As Range
 Dim PosCnt As Integer
 Dim ExpCnt As Integer

 PosCnt = 0
 ServCnt = 0
 ExpCnt = 0

'Counting all project positions for the chosen project number
For Each Cell In Range("ProjectList")
   If Cell.Value = Range("IdSelect") Then
       PosCnt = PosCnt + 1
    End If
Next Cell

MsgBox "Total number of line items: " & PosCnt

'Counting all positions of that project that are consulting services
For Each Cell In Range("ProjectList")
   If Cell.Value = Range("IdSelect").Value And Cell.Offset(0, 3).Value = "Service" Then
    ServCnt = ServCnt + 1
   End If
Next Cell

MsgBox "Total number of consulting services: " & ServCnt

'Calculating number of expense items
ExpCnt = PosCnt - ServCnt

MsgBox "Total number of expenses: " & ExpCnt


End Sub

Sub Count_Total_Rows()

Dim Current_RowCnt As Integer
Dim Target_RowCnt As Integer
Dim Diff_Rows As Integer

Target_RowCnt = 62

'Counting the rows in the print area and calculating difference to target
Sheets("Invoice").Activate
Range("Print_Area").Select
Current_RowCnt = Selection.Rows.Count
Diff_Rows = Target_RowCnt - Current_RowCnt
    If Diff_Rows > 0 Then
        MsgBox "We need to add " & Diff_Rows & " rows!"
    ElseIf Diff_Rows < 0 Then
        MsgBox "We need to delete " & -Diff_Rows & " rows!"
    Else
        MsgBox "Nothing needs to be done; all good!"
    End If


End Sub

Sub Write_Services(ServCnt)
'Looks up services on data sheet and writes them to invoice sheet
    Dim Cnt As Integer
    Dim PosIdent As String
    Dim Data As Range

Cnt = 0
'Building position identifier

Sheets("Input").Select
ActiveSheet.Range("D26:AD151").Select
Set Data = Selection
PosIdent = Range("IdSelect").Value & "/" & Cnt + 1

Sheets("Invoice").Select
ActiveSheet.Range("Service_Title").Offset(1, 0).Activate
'There is still an issue with the counter (line number won't increment by 1 if cnt range is incremented by 1
For Cnt = 0 To ServCnt + 1
    ActiveCell.Value = Application.WorksheetFunction.VLookup(PosIdent, Data, 15, False)
    ActiveCell.Offset(1, 0).Activate
    Cnt = Cnt + 1
Next Cnt

End Sub

score 1 · Accepted Answer

これは暗闇でのショットかもしれませんが、あなたのエラーはここにあると思います

PosIdent = "IdSelect" & "/" & Cnt + 1

それはあるべきです

PosIdent = Range("IdSelect").Value & "/" & Cnt + 1

また、これを一度だけ定義していることに気付きました。そのため、範囲が変更されても変更されません。このコードをここに移動します

For Cnt = 0 To ServCnt + 1
    PosIdent = Range("IdSelect").Value & "/" & Cnt + 1
    ActiveCell.Value = Application.WorksheetFunction.VLookup(PosIdent, Data, 15, False)
    ActiveCell.Offset(1, 0).Activate
Next Cnt

それが役立つことを願っています

アップデート

これを試して：

Option Explicit
Public ServCnt As Integer
Sub Main()

Call Count_Line_Items
Call Count_Total_Rows
Call Write_Services

End Sub
Sub Count_Line_Items()

'Counts the number of line items of a consulting project to determine the space needed on the invoice form

 Dim Cell As Range
 Dim PosCnt As Integer
 Dim ExpCnt As Integer

 PosCnt = 0
 ServCnt = 0
 ExpCnt = 0

'Counting all project positions for the chosen project number
For Each Cell In Range("ProjectList")
   If Cell.Value = Range("IdSelect") Then
       PosCnt = PosCnt + 1
    End If
Next Cell

MsgBox "Total number of line items: " & PosCnt

'Counting all positions of that project that are consulting services
For Each Cell In Range("ProjectList")
   If Cell.Value = Range("IdSelect").Value And Cell.Offset(0, 3).Value = "Service" Then
    ServCnt = ServCnt + 1
   End If
Next Cell

MsgBox "Total number of consulting services: " & ServCnt

'Calculating number of expense items
ExpCnt = PosCnt - ServCnt

MsgBox "Total number of expenses: " & ExpCnt
End Sub

Sub Count_Total_Rows()

Dim Current_RowCnt As Integer
Dim Target_RowCnt As Integer
Dim Diff_Rows As Integer

Target_RowCnt = 62

'Counting the rows in the print area and calculating difference to target
Range("Print_Area").Select
Current_RowCnt = Selection.Rows.Count
Diff_Rows = Target_RowCnt - Current_RowCnt
    If Diff_Rows > 0 Then
        MsgBox "We need to add " & Diff_Rows & " rows!"
    ElseIf Diff_Rows < 0 Then
        MsgBox "We need to delete " & -Diff_Rows & " rows!"
    Else
        MsgBox "Nothing needs to be done; all good!"
    End If
End Sub

Sub Write_Services() 'Looks up services on data sheet and writes them to invoice sheet Dim Cnt As Integer Dim PosIdent As String Dim Data As Range

Cnt = 0
'Building position identifier

Sheets("Input").Select
ActiveSheet.Range("D26:AD151").Select
Set Data = Selection
PosIdent = Range("IdSelect").Value & "/" & Cnt + 1

Sheets("Invoice").Select
ActiveSheet.Range("Service_Title").Offset(1, 0).Activate
'There is still an issue with the counter (line number won't increment by 1 if cnt range is incremented by 1
For Cnt = 0 To ServCnt + 1
    ActiveCell.Value = Application.WorksheetFunction.VLookup(PosIdent, Data, 15, False)
    ActiveCell.Offset(1, 0).Activate
    Cnt = Cnt + 1
Next Cnt
End Sub

excel - VBA ルックアップ - WorkSheet 関数クラスの Vlookup プロパティを取得できません

1 に答える 1

Related

Reference