搜索表 2 中的数据并将其粘贴到表 1 表单答案

【问题标题】：Search and paste data from sheet 2 to sheet 1 form搜索表 2 中的数据并将其粘贴到表 1 表单
【发布时间】：2015-03-18 01:03:58
【问题描述】：

我有 Sheet1，它是一个带有字段的表单，我们在其中输入要输入数据库的数据 (Sheet2)。

理想情况下，这就是我想要它做的事情：

我想使用 Sheet1 中的表单内容搜索字段/记录，然后在 Sheet2 中搜索该术语。如果 Sheet2 上不存在，给我一条弹出消息说数据不存在。

如果它确实存在于 Sheet2 的 A 列中，则选择结果右侧的单元格（B 列）。然后将该单元格的内容粘贴到 Sheet1 的相关字段中然后继续，直到在 Sheet2 上搜索到 Sheet1 上的所有字段。

这是我一直在使用的代码。在出现错误之前，它仅适用于大约 5 行。任何帮助将不胜感激。

我真的不想让 MsgBox 弹出来。

Sub abc()

Do Until IsEmpty(ActiveCell)
    Dim MyString As String
    MyString = ActiveCell
    Sheets("Sheet2").Select
    Set RangeObj = Cells.Find(What:=MyString, After:=ActiveCell, _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
    If RangeObj Is Nothing Then MsgBox "Not Found" Else: RangeObj.Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(-1, -1).Select
Loop
End Sub

请让我知道我做错了什么。

【问题讨论】：

标签： excel vba

【解决方案1】：

您走在正确的道路上。只是对复制数据的方式进行了一些修改。

Option Explicit
Sub sheet2_lookup()
    Dim strVal As String
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet, RangeObj As Range
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Sheet1")
    Set ws2 = wb.Sheets("Sheet2")

    Cells(1, 1).Activate '' amend this to your starting cell
    While ActiveCell.Value2 <> ""
        strVal = ActiveCell.Value2
        Set RangeObj = ws2.Columns("A").Find(What:=strVal, After:=Cells(1, 1), LookIn:=xlValues)
        If RangeObj Is Nothing Then
            MsgBox "Not Found"
        Else
            ActiveCell.Offset(0, 1).Value2 = RangeObj.Offset(0, 1).Value2
        End If
        ActiveCell.Offset(1, 0).Activate
    Wend
End Sub

告诉我进展如何。

【讨论】：