0
我有两张工作簿。如果数值类似于或类似于表单x上的Vba查找值？
工作表Sheet1：
Column B Column C Column D Column E
Dairy Crest Ltd
Milk Farm
Tuna Family
Guiness
第2页：
Column A Column B Column C Column d
Dairy Crest James [email protected] 07874565656
Milk Farm Limited Kelly [email protected] 07874565656
Tuna's Families Dave [email protected] 07874565656
Guiness Prep Limited Tom [email protected] 07874565656
我想类似命名的公司相匹配。这不能说是否值=值，因为公司名称通常拼写不同。
相反，我想使用喜欢或通配符。这会工作吗？
如果我使用Value Like Value，这似乎不起作用。
如果找到了，我想将联系人姓名，电子邮件和联系电话号码复制到相关列中的表1中。
由于某种原因，这是行不通的。请有人能告诉我我要去哪里？
相关代码：
'Start second loop sequence
With ThisWorkbook.Worksheets(3)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
j2 = 2
For i2 = 1 To LastRow
' === For DEBUG ONLY ===
Debug.Print ThisWorkbook.Worksheets(2).Range("B" & j2).Value
If ThisWorkbook.Worksheets(2).Range("B" & j2).Value = .Range("A" & i2).Value Then ' check if Week No equals the value in "A1"
ThisWorkbook.Worksheets(2).Range("C" & j2).Value = .Range("B" & i2).Value
ThisWorkbook.Worksheets(2).Range("D" & j2).Value = .Range("D" & i2).Value
ThisWorkbook.Worksheets(2).Range("E" & j2).Value = .Range("C" & i2).Value
j2 = j2 + 1
End If
Next i2
End With
'End Second Loop
全码：
Option Explicit
Sub LoadWeekAnnouncementsFromPlanner()
Dim WB As Workbook
Dim WB2 As Workbook
Dim i As Long
Dim i2 As Long
Dim j As Long
Dim j2 As Long
Dim LastRow As Long
Dim ws As Worksheet
'Open Planner
'On Error Resume Next
Set WB = Workbooks("2017 Planner.xlsx")
On Error GoTo 0
If WB Is Nothing Then 'open workbook if not open
Set WB = Workbooks.Open("G:\BUYING\Food Specials\2. Planning\1. Planning\1. Planner\8. 2017\2017 Planner.xlsx", xlUpdateLinksNever, True, Password:="samples")
End If
'Open PhoneBook
'On Error Resume Next
'On Error GoTo 0
' ======= Edit #2 , also for DEBUG ======
With WB.Worksheets(1)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
j = 2
For i = 1 To LastRow
' === For DEBUG ONLY ===
Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("I8").Value)
If CInt(ThisWorkbook.Worksheets(1).Range("I8").Value) = .Range("A" & i).Value Then ' check if Week No equals the value in "A1"
ThisWorkbook.Worksheets(2).Range("A" & j).Value = .Range("A" & i).Value
ThisWorkbook.Worksheets(2).Range("B" & j).Value = .Range("N" & i).Value
ThisWorkbook.Worksheets(2).Range("H" & j).Value = .Range("K" & i).Value
ThisWorkbook.Worksheets(2).Range("I" & j).Value = .Range("L" & i).Value
ThisWorkbook.Worksheets(2).Range("J" & j).Value = .Range("M" & i).Value
ThisWorkbook.Worksheets(2).Range("K" & j).Value = .Range("G" & i).Value
ThisWorkbook.Worksheets(2).Range("L" & j).Value = .Range("O" & i).Value
ThisWorkbook.Worksheets(2).Range("M" & j).Value = .Range("P" & i).Value
ThisWorkbook.Worksheets(2).Range("N" & j).Value = .Range("W" & i).Value
ThisWorkbook.Worksheets(2).Range("O" & j).Value = .Range("Z" & i).Value
'Start second loop sequence
With ThisWorkbook.Worksheets(3)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
j2 = 2
For i2 = 1 To LastRow
' === For DEBUG ONLY ===
Debug.Print ThisWorkbook.Worksheets(2).Range("B" & j2).Value
If ThisWorkbook.Worksheets(2).Range("B" & j2).Value = .Range("A" & i2).Value Then ' check if Week No equals the value in "A1"
ThisWorkbook.Worksheets(2).Range("C" & j2).Value = .Range("B" & i2).Value
ThisWorkbook.Worksheets(2).Range("D" & j2).Value = .Range("D" & i2).Value
ThisWorkbook.Worksheets(2).Range("E" & j2).Value = .Range("C" & i2).Value
j2 = j2 + 1
End If
Next i2
End With
'End Second Loop
j = j + 1
End If
Next i
End With
End Sub
请能有人告诉我在哪里，我错了？
刚刚举了一个例子，如果你在每个公司名称中都有独立的前4个字符，你可以将asdf变暗为字符串，然后asdf = left（REF，4）.text（可能要使用.value而不是.text）。有了这个，你可以将REF单元格与asdf＆“*”相匹配，如果是true，则复制该行。考虑到我只看到示例图表，这至少是对流程的一个快速考虑。 – Cyril
@Cyril品牌新vba，这将如何完成？你有一个示例代码？ – user7415328
为什么不使用LIKE运算符？在VBA它的 - “如果myValue LIKE'* checkagainstValue *'然后做一些东西” –