如果将粘贴工作表 1 b 匹配到工作表 2 b，则将某些文本工作表 1 a 与工作表 2 a 匹配

Question

我有一张工作表 1，其 A 列中有名称，而工作表 2 的 A 列中有名称。除了工作表 2 上的逗号或句点（而不是工作表 1 上的逗号或句点）外，名称大部分相同。我需要匹配一些文本和将工作表 1 的 B 列粘贴到工作表 2 的 B 列。

示例：

工作表 1

A                        B
Doug, Inc.             $12.03
For it all, LLC        $4452.03
Go for it, Inc.        $235.60

Sheet 2
A                        B
Doug, Inc - Joe          
For it all - Mike
Go for it Inc - Tom

我的代码只有在名称完全匹配（在破折号“-”之前）时才会匹配和粘贴。 我需要帮助让它只匹配一些文本，而不关心逗号或句点。

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Set ws1 = Sheets(1)
    Set ws2 = Sheets(2)
    Set rng1 = ws2.Range(ws2.[a1], ws2.Cells(Rows.Count, "A").End(xlUp))
 With rng1.Offset(0, 1)
    .FormulaR1C1 = "=IF(RC[-1]<>"""",IF(NOT(ISERROR(MATCH(LEFT(RC[-1],FIND("" - "",RC[-1])-1),'" & ws1.Name & "'!C[-1],0))),INDEX('" & ws1.Name & "'!C,MATCH(LEFT(RC[-1],FIND("" - "",RC[-1])-1),'" & ws1.Name & "'!C[-1],0)),""""),"""")"
    .Value = .Value
End With

Answer 1

我已经重构了您的公式，

1. 如果您对工作表 1 数据使用命名范围，它将简化您的代码。在这里，我使用了名称 Data
2. 我使用了 VLookup 而不是 Index(Match() 来进一步缩短公式
3. 双 Substitute 的替换查找范围中的 , 和 .
4. 公式必须是 Substitues< 的数组公式 > 工作。
5. / code Substitute 返回的值是一个字符串，我已将函数包装在 Value 中以转换回数字，如果不需要，请删除它。
6. 查找值是之前准备好的。对 VLookup 的调用，剥离 - ...（如果存在）

'

.FormulaArray = "=VALUE(VLOOKUP(" & _
  "LEFT(RC[-1],IFERROR(FIND("" - "",RC[-1])-1,LEN(RC[-1])))," & _
  "SUBSTITUTE(SUBSTITUTE(Data,"","",""""),""."",""""),2,0))"

我不确定您的示例数据的一个方面
For it all - Mike 将成为For it all。
- 这不会匹配For it all, LLC（变成For it all LLC）

Go for it Inc - Tom< /code> 将成为 Go for it Inc。
- 这将匹配Go for it, Inc.（变成Go for it Inc）

Doug, Inc - Joe 将成为 Doug, Inc。
此不会匹配 Doug, Inc.（将成为 Doug Inc`）

-如果您想忽略 、 和 ，则 。< /code> 在两个工作表中，使用

.FormulaArray = "=VALUE(VLOOKUP(" & _
  "SUBSTITUTE(SUBSTITUTE(LEFT(RC[-1],IFERROR(FIND("" - "",RC[-1])-1,LEN(RC[-1]))),"","",""""),""."","""")," & _
  "SUBSTITUTE(SUBSTITUTE(Data,"","",""""),""."",""""),2,0))"

Answer 2

我不确定我是否理解您想要实现的目标。我不明白你的代码似乎只是清除了工作表 2 的 B 列。我不明白你为什么使用宏来设置公式。

下面的代码做了我认为你想做的事情。如果没有，我希望我的代码能给您足够的想法，以便您可以创建您想要的代码。

我猜您对 Excel Basic 不太熟悉。如果以下内容侮辱了您的知识，请抱歉。我想你宁愿被侮辱也不愿被困惑。

Sub Test2()

  ' This is revised coding.  I had not read the question carefully enough
  ' so my original code did not do what was required.

  Dim Pos2 As Integer           ' The 1s and 2s in variable names
  Dim RowCrnt As Integer        ' identify the variable as being for Sheet1
  Dim RowMax As Integer         ' or Sheet2.  The same row variables are
  Dim S1ColAB() As Variant      ' used for both sheets.
  Dim S2ColAB() As Variant
  Dim Value1 As String
  Dim Value2 As String

  With Sheets("Sheet2")
    ' I generally use Find instead of End(xlUp) for reasons I no longer
    ' remember. This searches column A (Columns("A")) for anything ("*")
    ' starting from cell A1 (Range("A1")) and moving backwards
    ' (xlPrevious) until it finds a value.
    RowMax = .Columns("A").Find("*", .Range("A1"), xlFormulas, , _
                                                xlByRows, xlPrevious).Row

    ' Range(Cells(A,B),Cells(C,D)) defines a rectangle of cells with Row=A,
    ' Col=B as top left and Row=C, Col=D as bottom right.
    ' The following statement loads the contents of a block of cells to a
    ' variant array.  Another question has led to a discussion about the value
    ' of using variant arrays in this way.  I have found that moving values
    ' from one sheet to another can be very slow so I believe it is useful in
    ' this situation.
    S2ColAB = .Range(.Cells(1, 1), .Cells(RowMax, 2)).Value

    ' Warning about moving values from a cell into a string or variant variable
    ' and then from the variable into another cell.
    ' =========================================================================
    ' When moving the value from the variable to the cell, Excel will
    ' misinterpret the value if it can.
    '
    ' For example, if the value is 13/1/11 (13 January 2011 here in England)
    ' this value will be correctly transferred into the new cell.  But if the
    ' value is 4/1/11 (4 January 2011), Excel will recognise this as a valid
    ' American date and set the new cell to 1 April 2011.  The damage that bug
    ' caused by corrupting a third my dates!  I had tested my code towards the
    ' end of a month and it worked perfectly until the next month.
    '
    ' In this example, string $12.03 becomes currency 12.03 and displays
    ' here as £12.03.

  End With

  With Sheets("Sheet1")
    ' Load the matching cells from sheet 1
    S1ColAB = .Range(.Cells(1, 1), .Cells(RowMax, 2)).Value
  End With

  With Sheets("Sheet2")
    For RowCrnt = 1 To RowMax
      ' I move the Column A values for matching row from the arrays to string
      ' variables so I can amend their values without losing the original
      ' values.  This was essential with my original code and I have not
      ' changed it since I think it makes the code easier to understand and
      ' probably marginally faster.
      Value1 = S1ColAB(RowCrnt, 1)
      Value2 = S2ColAB(RowCrnt, 1)
      ' The following code removes anything following a hyphen from Value 2.
      ' It then removes all commas and dots from both Value1 and Value2.  If
      ' the final values are the same, it moves the Column B of Sheet1 to
      ' Sheet2.
      Pos2 = InStr(1, Value2, "-")
      If Pos2 <> 0 Then
        ' Pos2 is not zero so extract the portion of Value2 up to the "-"
        ' and then trim trailing spaces.
        Value2 = RTrim(Mid(Value2, 1, Pos2 - 1))
      End If
      ' Replace all commas with nothing.
      Value1 = Replace(Value1, ",", "")
      ' Replace all dots with nothing.
      Value1 = Replace(Value1, ".", "")
      ' Merge the two replaces into a single statement.
      Value2 = Replace(Replace(Value2, ",", ""), ".", "")
      If Value1 = Value2 Then
        ' If the modified values are equal, copy the Column 2 (B) from
        ' Sheet1 to Sheet2.
        .Cells(RowCrnt, 2).Value = S1ColAB(RowCrnt, 2)
      End If
    Next

  End With

End Sub

希望这有帮助。如果我没有充分解释自己，请回来。