Excel 从数据列表中将数据从Sheet1提取到Sheet2

我对脚本编写相当陌生，我发现自己被困在一个简单的解决方案上。总之，在excel中，我的所有数据都在Sheet1（导入）中，我希望使用A列（在Sheet2上）作为要提取的数据列表，将该列表中的数据提取到Sheet2（导出）中

我已经成功地获取了数据，但是，我无法获取它的倍数。例如，我在A列（Sheet2）中有ABC，我单击我的按钮拉取数据，它拉取Sheet1上找到的第一个ABC，然后停止。在进入下一个单元格进行搜索之前，我需要它将所有ABC从表1中删除

这是我的第一篇文章，所以如果这是一篇粗略的阅读或者我应该添加更多的内容，我很抱歉

---------------代码----------------

---

您只处理第一个找到的项目。您可以使用

Do

循环来处理所有这些问题，如下所示

Set Found = Sheets(1).Columns("F").Find(What:=answer1, LookAt:=xlWhole, SearchDirection:=x1Next)
If Not Found Is Nothing Then
   Do Until Found Is Nothing
      'your logic for each found item
       Set Found = Sheets(1).Columns("F").FindNext(Found)
   Loop
End If

---

您只处理第一个找到的项目。您可以使用

Do

循环来处理所有这些问题，如下所示

Set Found = Sheets(1).Columns("F").Find(What:=answer1, LookAt:=xlWhole, SearchDirection:=x1Next)
If Not Found Is Nothing Then
   Do Until Found Is Nothing
      'your logic for each found item
       Set Found = Sheets(1).Columns("F").FindNext(Found)
   Loop
End If

---

我感谢您的帮助，在获得了许多可能的解决方案之后，我们最终使用了下面的代码。再次感谢大家的帮助

Private Sub ExtractData_Click()

    Dim i As Integer
    Dim j As Integer
    Dim intSourceRowCt As Integer
    Dim intSearchRowCt As Integer
    Dim intCopyToRow As Integer
    'Set row to Start Copying to
    intCopyToRow = 2
    'Listed Data to locate
    intSourceRowCt = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
    intSearchRowCt = Sheets(1).Range("F" & Rows.Count).End(xlUp).Row
    'Loop through Source
    For i = 2 To intSourceRowCt
        'Loop through Search
        For j = 2 To intSearchRowCt
            'Copy Row if Matches
            If (Worksheets(1).Range("F" & j).Value = Worksheets(2).Range("A" & i).Value) Then
                Worksheets(2).Range("C" & intCopyToRow).Value = Worksheets(1).Range("F" & j).Value
                Worksheets(2).Range("D" & intCopyToRow).Value = Worksheets(1).Range("G" & j).Value
                Worksheets(2).Range("E" & intCopyToRow).Value = Worksheets(1).Range("H" & j).Value
                Worksheets(2).Range("F" & intCopyToRow).Value = Worksheets(1).Range("C" & j).Value
                Worksheets(2).Range("G" & intCopyToRow).Value = Worksheets(1).Range("E" & j).Value
                'Increment Insert Row
               intCopyToRow = intCopyToRow + 1
            End If
        Next j
    Next i
End Sub

---

我感谢您的帮助，在获得了许多可能的解决方案之后，我们最终使用了下面的代码。再次感谢大家的帮助

Private Sub ExtractData_Click()

    Dim i As Integer
    Dim j As Integer
    Dim intSourceRowCt As Integer
    Dim intSearchRowCt As Integer
    Dim intCopyToRow As Integer
    'Set row to Start Copying to
    intCopyToRow = 2
    'Listed Data to locate
    intSourceRowCt = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
    intSearchRowCt = Sheets(1).Range("F" & Rows.Count).End(xlUp).Row
    'Loop through Source
    For i = 2 To intSourceRowCt
        'Loop through Search
        For j = 2 To intSearchRowCt
            'Copy Row if Matches
            If (Worksheets(1).Range("F" & j).Value = Worksheets(2).Range("A" & i).Value) Then
                Worksheets(2).Range("C" & intCopyToRow).Value = Worksheets(1).Range("F" & j).Value
                Worksheets(2).Range("D" & intCopyToRow).Value = Worksheets(1).Range("G" & j).Value
                Worksheets(2).Range("E" & intCopyToRow).Value = Worksheets(1).Range("H" & j).Value
                Worksheets(2).Range("F" & intCopyToRow).Value = Worksheets(1).Range("C" & j).Value
                Worksheets(2).Range("G" & intCopyToRow).Value = Worksheets(1).Range("E" & j).Value
                'Increment Insert Row
               intCopyToRow = intCopyToRow + 1
            End If
        Next j
    Next i
End Sub

---

Kevin，我已经添加了Do循环，但是当我尝试运行时，代码给了我“无效或不合格的引用”。调试突出显示.FindNext。我将继续研究我所缺少的东西；如果我在回复之前找到了答案，我会让你知道我想到了什么。感谢您的回复，很高兴我至少走上了正确的道路。很抱歉，我的测试代码被包装在at With block中。请更改为：

Sheets（1）.Columns（“F”）.FindNext（Found）

Kevin，我已经添加了Do循环，但是当我尝试运行时，代码给了我“无效或不合格的引用”。调试突出显示.FindNext。我将继续研究我所缺少的东西；如果我在回复之前找到了答案，我会让你知道我想到了什么。感谢您的回复，很高兴我至少走上了正确的道路。很抱歉，我的测试代码被包装在at With block中。请更改为：

Sheets（1）.Columns（“F”）.FindNext（Found）