Question

我有一个在A列中有名字的sheet1，我在表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数据使用命名范围，它将简化您的代码。我在这里使用了名称Data
我使用VLookup而不是Index(Match(来进一步缩短公式
查询范围内的Substitute替换,和.
公式必须为Array formula Substitues才能生效。
由于Substitute返回的值是一个字符串。我已经将函数包含在Value中以转换回数字，如果不需要则删除它。
查询值是在调用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将成为Go for it Inc - 此将匹配Go for it, Inc.（变为Go for it Inc）

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

如果您想忽略两个表中的,和.，请使用

.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

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

如果匹配粘贴片1b与片材2b，则将一些文本片材1a与片材2a匹配

2 个答案: