将 table 中的匹配数据提取到 Excel VBA 中的另一个工作表

Question

我在 Sheet1 中有一个示例 table，如下所示：

Location    Model   Part #
BF03    200W    40536573
BF04    200W    40536573
CV01    120W    40536585
CV02    135W    20085112
CV03    900W    20349280
CV04    135W    20085112

因为 BF03 的参考数据在单元格 B6 中。

我需要它做的是： A) 当用户在 Sheet3 中输入零件号（例如：40536573）时说单元格 A1，只会拾取匹配的位置 B) 拾取的 "location" 值将在从单元格 A6 开始的 Sheet2 中制成表格。

输出将如下所示：

Location    Model   Part #
BF03    200W    40536573
BF04    200W    40536573

为了让事情变得更复杂，我需要将 "Location" 数据连接成一个字符串并将其存储在 Sheet 2 单元格 A2 中。

我猜我们需要做一个 For 循环计数行，但我找不到关于如何正确编写它的任何参考。

下面是我的错误 "OVERFLOW" 代码的样子

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim FindMatch As String
    Dim Rng As Range
    Dim counter As Integer
    counter = ActiveWorkbook.Worksheets("Sheet2").Range("A6", Worksheets("Sheet2").Range("A6").End(xlDown)).Rows.Count
    For i = 6 To counter
    'Get the value from other sheet set as FindMatch
    FindMatch = Sheets("Sheet3").Cell("A1").Value
    'Find each row if matches the desired FindMatch
    If Trim(FindMatch) <> "" Then
        With Sheets("Sheet2").Range("D" & i).Rows.Count
            Set Rng = .Find(What:=FindMatch, _
                            after:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                'copy the values required to the cell
                Cells(i, 2) = Sheets("Sheet2").Cells(Rng.Row, 2)

            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
    Next i
End Sub

Answer 1

我没有使用 .find 方法，而是设法使用了一个简单的 for 循环。我猜有时您需要考虑简单 :) 我还添加了一个小功能来清除以前使用的字段。如果您遇到任何问题，请检查并反馈，我们可以尝试修复它。

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim S_Var As String
Dim copyRange As Range
Dim ws1_lastrow As Long
Dim ws2_lastrow As Long
Dim searchresult As Range

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
S_Var = ws3.Range("A1").Value
ws1_lastrow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
Set copyRange = ws1.Range("A1:C" & ws1_lastrow)

'Clear Data
ws2.Range("A2").Value = ""
If Range("A7").Value <> "" Then
ws2.Range("A7:C" & ws2.Range("A" & ws1.Rows.Count).End(xlUp).Row).Value = ""
End If

'Searchin through the sheet1 column1
For i = 2 To ws1_lastrow
    If ws1.Range("C" & i) = S_Var Then
        ws2_lastrow = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
        ws1.Range("A" & i & ":C" & i).Copy Destination:=ws2.Range("A" & ws2_lastrow + 1)
    End If
Next


'Adding location to sheet2 A2 as string
ws2_lastrow = ws2.Range("A" & ws1.Rows.Count).End(xlUp).Row
For i = 7 To ws2_lastrow 'starting from 7, where location starts
    If ws2.Range("A2").Value = "" Then
        ws2.Range("A2").Value = ws2.Range("A" & i).Value
        Else
        ws2.Range("A2").Value = ws2.Range("A2").Value & "," & ws2.Range("A" & i).Value
    End If
Next

将 table 中的匹配数据提取到 Excel VBA 中的另一个工作表

Extract matched data from a table to another worksheet in Excel VBA

excel

vba

excel-formula