Question

我正在尝试根据Vlookup的结果用来自另一个工作表的数据填充表。

Sheet1 Range（“ receiptNum”）有一个将从Sheet4（“ transcTable”）搜索的数字数据，当我运行Sub时，它实际上找到了“匹配的数字”，但是它一直向下一直写入数据目标表。如果找不到数据，我还需要添加什么代码来处理错误？

这是我的代码：

Dim ws As Worksheet
Dim intItems As Integer
Dim cellx As Range, rowX As Range
Set rowX = Sheet1.Range("A12")


Application.EnableEvents = False
Application.ScreenUpdating = False
 For Each ws In ActiveWorkbook.Worksheets
  ws.Unprotect
 Next ws


 Range("date").Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 2, False) 'Date
 Range("name").Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 3, False) 'Name


 intItems = 0
 For Each cellx In Range("receiptNumRec")
  CellXRow = CellXRow + 1
  If Range("receiptNum").Value > "" Then
   intItems = intItems + 1
    rowX.Offset(intItems - 1, 1).Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 1, False)
     If rowX.Offset(intItems - 1, 1).Value > "" Then
      rowX.Offset(intItems - 1).Value = intItems 'Item Num
     End If


  End If
 Next cellx


 For Each ws In ActiveWorkbook.Worksheets
  ws.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
 Next ws
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Answer 1

我的解决方法是使用ListObjects.Range.AdvancedFilter然后在提取的表上循环vlookup，我知道这是一个复杂的代码，但至少可以正常工作。仅当源表和目标表的格式和列数相同时，AdvancedFilter才是一个很棒的功能。

Dim ws As Worksheet, numX
numX = Application.VLookup(Range("receiptNum"), Sheet4.Range("transcTable"), 1, False)

If Not IsError(numX) Then
Application.EnableEvents = False
Application.ScreenUpdating = False
 For Each ws In ActiveWorkbook.Worksheets
  ws.Unprotect
 Next ws
 
  With Sheet4
    If Sheet1.Cells(8, 6) <> "" Then
      .Cells(1, 10).CurrentRegion.ClearContents
      .Cells(1, 19) = .Cells(1).Value
      .Cells(2, 19) = Sheet1.Cells(8, 6)
      .ListObjects(1).Range.AdvancedFilter 2, .Range("S1:S2"), .Cells(1, 10)
    End If
  End With
 Range("pickSlipClear,contactDetails").ClearContents
 Call transcSearch 'run Search function
 Cells(Rows.Count, "C").End(xlUp).Offset(2).Select
    
 For Each ws In ActiveWorkbook.Worksheets
  ws.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
 Next ws
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 
Else
 MsgBox "Receipt Number doesn't exist!"
 Cells(Rows.Count, "C").End(xlUp).Offset(2).Select
 
End If
End Sub

Sub transcSearch()
Dim i As Integer
Dim lng As Long
Dim xcell As Range, rowX As Range
Set rowX = Sheet1.Cells(12, 1)

 Range("date").Value = Application.VLookup(Range("receiptNum"), Sheet4.Range("transcTable"), 2, False) 'Date
 Range("name").Value = Application.VLookup(Range("receiptNum"), Sheet4.Range("transcTable"), 3, False) 'Name
   i = 0
   lng = 0
   For Each xcell In Range("prodX")
    i = i + 1
    lng = lng + 1
    If xcell.Value > "" Then
      rowX.Offset(lng - 1).Value = i 'Item Num
      rowX.Offset(lng - 1, 1).Value = Application.VLookup(xcell.Value, Sheet4.Range("filterX"), 2, False) 'Type
      rowX.Offset(lng - 1, 2).Value = Application.VLookup(xcell.Value, Sheet4.Range("filterX"), 1, False) 'Description
      rowX.Offset(lng - 1, 3).Value = Application.VLookup(xcell.Value, Sheet4.Range("filterX"), 3, False) 'Qty
      rowX.Offset(lng - 1, 4).Value = Application.VLookup(xcell.Value, Sheet4.Range("filterX"), 4, False) 'Unit
      rowX.Offset(lng - 1, 7).formula = "=IFERROR(INDEX(dataTable[ON-HAND],MATCH(@desc,dataTable[Product Description],0)),0)" ' Available stock
      rowX.Offset(lng - 1, 8).formula = "=IFERROR(INDEX(dataTable[Supplier],MATCH(@desc,dataTable[Product Description],0)),0)" 'Stock cost price
    End If
   Next xcell
End Sub

自动从另一个工作表填充表格

1 个答案: