Question

我在Sheet1中有一个样本表，如下所示：

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）从单元格A6开始，拾取的“位置”值将在Sheet2中列表。

输出看起来像这样：

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

为了使事情变得更复杂，我需要将“位置”数据连接成一个字符串并将其存储在Sheet 2 Cell 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

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

1 个答案: