使用 Vba 复制数据，Match 功能

Question

我是一名新程序员。 只是 vba 的初学者，希望得到一些帮助来解决这个问题。 我知道我可以使用普通的 excel 公式，但这是为了学习。 到目前为止，这是我的代码：

Sub matchpart()
Dim ocell As Range
Dim swb As Workbook
Dim sws As Worksheet, dws As Worksheet
Dim stext As String
Dim iRow As Long
Dim nxtRow As Long


Set swb = ActiveWorkbook
Set sws = swb.Sheets("sheet1")
Set dws = swb.Sheets("sheet2")

For Each ocell In dws.Range("FILE_NAMES")
    stext = Left(ocell.Value, 12)
On Error Resume Next
iRow = Application.WorksheetFunction.Match(stext, sws.Range("ID_NUMBER"), 0)
On Error GoTo 0
    If iRow > 0 Then
       Application.Index (Range("ID_PARENT").Copy)
    Else
        ocell.Offset(0, 1) = ""
        End If
        Next

MsgBox ("Done")
End Sub

我的任务是将工作表 2 (ID_NUMBER) 中的 1 列与工作表 1 (FILE_NAMES) 的 1 列相匹配。在此之后复制工作表 1 下一列中的相应值（已匹配）并将其粘贴到工作表 2 的下一列中。

这是我的数据，例如 表 1：

ID_PARENT     ID_NUMBER 
pan               3
same              2
kappa             1
lame              5
dame              5

sheet 2:

FILE_NAMES      BPM_LIST
1                   
5
3
2
4
5

因此想使用我的代码匹配并复制到 BPM_LIST。

Answer 1

不要使用Application.WorksheetFunction.Match(...)；使用Application.Match(...) 并将返回值传递回一个变体。这将允许您与IsError(...) 联系。

此外，（就像在工作表上使用 MATCH 一样），您无法使用 text-that-looks-like-a-number 找到数字；例如1 <> "1"。我不知道您的数据实际上是什么样的（真实数字或看起来像数字的文本），但您可能必须在匹配中使用 Int(stext) 而不是 stext。

dim iRow  as variant
For Each ocell In dws.Range("FILE_NAMES")
    stext = Left(ocell.Value, 12)
    iRow = Application.Match(stext, sws.Range("ID_NUMBER"), 0)
    If IsError(iRow) Then
        ocell.Offset(0, 1) = vbnullstring
    Else
       ocell.Offset(0, 1) = Range("ID_PARENT").Cells(iRow, 1).Value
    End If
Next ocell 

Answer 2

您希望学习和学习代码。这里是。我没有太在意它是否也能做你想要的，因为我认为你可以按照你希望它弯曲的方向调整我的代码。玩得开心！

Sub matchpart()
    ' 10 Apr 2017

    Dim Wb As Workbook
    Dim WsSrc As Worksheet                  ' Identify the sheet as Source
    Dim WsTgt As Worksheet                  ' Identify the sheet as Target
    Dim sText As String
    Dim R As Long, lastRow As Long          ' last row in WsTgt
    Dim iRow As Long                        ' why do you call "Found row" iRow?

    Set Wb = ActiveWorkbook                 ' actually, this is the default
    With Wb                                 ' declaring it just reminds you of the fact
        Set WsSrc = .Sheets("IDs")
        Set WsTgt = .Sheets("File Names")   ' I used my own names for testing
    End With

    With WsTgt
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        ' most programmers prefer to call the columns by their numbers
        ' instead of their names (like "A") as I have done here.
        ' VBA must convert the names to numbers.
        ' Therefore using numbers to begin with is faster.
        ' You can change all names to numbers in this code
        ' Just replace "A" with 1, "B" with 2 etc.

        For R = 2 To lastRow                ' omit row 1 (captions)
            sText = .Cells(R, "A").Value    ' can't use partial with MATCH function
            On Error Resume Next
            iRow = WorksheetFunction.Match(sText, WsSrc.Columns("B"), 0)
            If Err.Number = 0 Then
                .Cells(R, "B").Value = WsSrc.Cells(iRow, "A").Value
            End If
            Err.Clear
        Next R
    End With

    MsgBox ("Done")
End Sub

我的代码偏离您的意图的地方是您想要“部分匹配”。使用 MATCH 工作表功能无法实现这一点。您需要为此使用 VBA 的 Find 。但这最好改天再上一课，哈哈：

Answer 3

您好，很抱歉占用您的时间。 我找到了解决问题的方法。 这只是使用索引函数，因为我已经得到了匹配的行号，即 iRow。

Sub matchpart()
Dim ocell As Range
Dim ocells As Range
Dim swb As Workbook
Dim sws As Worksheet, dws As Worksheet
Dim stext As String
Dim iRow As Long
Dim nxtRow As Long


Set swb = ActiveWorkbook
Set sws = swb.Sheets("sheet1")
Set dws = swb.Sheets("sheet2")

For Each ocell In dws.Range("FILE_NAMES")
    stext = Left(ocell.Value, 12)
On Error Resume Next
iRow = Application.WorksheetFunction.Match(stext, sws.Range("ID_NUMBER"), 0)
On Error GoTo 0
    If iRow > 0 Then
       ocell.Offset(0, 1) = WorksheetFunction.Index(sws.Range("ID_PARENT"), iRow, 0)

    Else
        ocell.Offset(0, 1) = ""
        End If
        Next

MsgBox ("Done")
End Sub

无论如何感谢您的帮助:)