Question

我有一张2张工作簿。

Sheet 1中：

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        james@email.com    07874565656
Milk Farm Limited          Kelly        kely@email.com     07874565656
Tuna's Families            Dave         dave@email.com     07874565656
Guiness Prep Limited       Tom          tom@email.com      07874565656

我想匹配类似的公司。如果值=值，则不能说这是因为公司名称通常拼写不同。

相反，我想使用like或wildcard。这会有用吗？

如果我使用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

Full COde：

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

请有人告诉我我哪里出错了吗？

Answer 1

这是一个很好的例子，如何在VBA中使用Like。在控制台窗口中尝试，以获得答案。

?"Vito6" Like "V?to6"
True
?"Vito6" Like "Vito#"
True
?"Vito6" Like "V*6"
True
?"Vito6" Like "Vit[a-z]6"
True
?"Vito6" Like "Vit[A-Z]6"
False
?"Vito6" Like "Vit[!A-Z]6"
True
?"12 34" Like "## ##"
True
?"12 34" Like "1[0-9] [0-9]4"
True

Answer 2

试着从我留给你的评论中详细说明我的想法：

Dim asdf as String
Dim i as Variant
Dim LR as Long

LR = Sheets("Sheet2").Cells(.Rows.Count, "A").End(xlUp).Row

For i = 2 to LR 'Sheet1 looks to start on row 3, while Sheet2 looks to start on row2
    asdf = Sheets("Sheet1").Cells(i+1,2).Value

    If Sheets("Sheet2").Cells(i,1).Value Like "*asdf*" Then 'you left out the asterisks
        'true: copy data
        Else:
        'false: can just be nothing here
        End If

    Next i

类似于我的建议。像@DougCoats所建议的那样使用类似运算符。

Answer 3

如果没有特定原因需要VBA，您可以将@Cyril在评论中提供的解决方案应用于Sheet1上的Excel单元格公式。

例如，在Sheet1，Cell F1中，您可以输入：

=LEFT(B1, 4)
'This would return "Dair"

然后，在A列中，您可以使用嵌套的IF语句：

=IF(F1 = "dair", "Dairy Crest", IF(F1 = "milk", "Milk Farm Limited, IF(F1 = "tuna", "Tuna's Families", IF(F1 = "Guiness", "Guiness Prep Limited", "No match))))

Answer 4

虽然您可以使用通配符来使用like运算符比较字符串，但显式部分必须精确。所以

"*Dairy Crest*" like "Dairy Crest Ltd"可以很好地使用
但"*Tuna Family*" like "Tuna's Families"无效。

您可以尝试 模糊查找 以匹配第二种方案。它将概率用于查找。

这是源代码的链接。

https://www.mrexcel.com/forum/excel-questions/195635-fuzzy-matching-new-version-plus-explanation.html

对于模糊匹配概率的一个注释，如果将精度％设置得太低，匹配可能不是100％正确。如果准确性很重要，则将准确度％设置得更高。

如果值类似或类似于表x上的Vba Lookup值？

4 个答案: