Question

我有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

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

Answer 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

让我知道它是怎么回事。

搜索并粘贴从表2到表1的数据

1 个答案: