excel - VBA 查找 - 无法获取 WorkSheet 函数类的 Vlookup 属性

Question

我知道这里已经讨论过一个类似的问题：为什么 VBA 中的 VLookup 失败并出现运行时错误 1004？

但似乎没有解决我的问题。快速解释我想在这里做什么 - 这是我的第一篇 VBA 帖子，所以如果有任何问题清晰等问题，请告诉我。

我正在尝试构建一张发票表，该发票表基于

项目编号（在本例中为 1）
所有项目数据的数据集

每个项目活动都显示为一个单独的行项目，并由一个唯一标识符标识，由项目编号和行项目编号组成（因此对于项目一中的第三个行项目，它将是“1/3”）。标识符被格式化为字符串。所有输入数据都在名为“输入”的工作表上。

第二张表是称为“发票”的实际发票表。这个想法是根据每个项目的行项目数（仍在处理这部分）自动获得正确数量的空白行，并自动填写表格。最后一部分是当我尝试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