Question

这是我第一次在任何VBA编程站点上寻求帮助。我是VBA编程的新手（10年前有过一些经验），我正在尝试创建一个文档交叉引用工具，用户可以在其中轻松搜索文档编号，并查看其他文档中引用该文档编号的位置。我正在使用Excel 2010。

在过去3天搜索网站，并阅读Excel VBA编程为傻瓜（我）一个同事借给我，这是我目前编写的代码，它成功地提出了所需的查询框，但我不能似乎让搜索查询工作，或复制粘贴命令工作。

我尽最大努力尊重这个网站的规则，并展示我努力编写这些代码的努力，而不是让其他人完成所有工作，但我显然需要帮助：

Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim ws As Worksheet
Dim lngLstRow As Long
Dim lngLstCol As Long
Dim strSearch As String
Dim r As Long
Dim x As Variant

strSearch = InputBox("Please enter 5 digit document number to search for (e.g. 00002):", "Search Value")

Sheets("DMR").Select
'Loop through sheet DMR and search for "search value". The search value may be in several rows, but will only appear once in a row.
For r = 1 To endRow
x = Range("G3:EP7002").Value 'yes-there are 7002 rows of data all starting at column G and potentially ending at column EP. There are many blank cells.
If Cells(r, x).Value = "Search Value" Then

'Copy the cells at column A and D of found search value row in Sheet "DMR"
Range(Cells(r, "A"), Cells(r, "D")).Select
Selection.Copy

'Switch to sheet "SEARCH" & paste two cells from sheet "DMR" into sheet "SEARCH" cells A5:B5
Sheets("SEARCH").Select
Range(r, "A5:B5").Select
ActiveSheet.Paste

'Next time you find a match in sheet "DMR", it will be pasted in the next row on sheet "SEARCH"
pasteRowIndex = pasteRowIndex + 1

'Switch back to sheet DMR & continue to search for your criteria
Sheets("DMR").Select
    End If
Next r
End Sub

如果我还能提供任何其他信息，或者某种方式传达我想要获得的信息更清楚，请不要犹豫！

非常感谢你的耐心等待！

婆婆纳

Answer 1

这将在循环中搜索所需范围（G3：EP7002）以查找所有实例，并将其从A5：B5开始将其放入工作表（搜索）中。它缺少用户3578951的错误检查，但我让你想出来^ _ ^

Private Sub CommandButton1_Click()

Dim dmr As Worksheet
Dim strSearch As String
Dim f As Variant
Dim fAddress As String
Dim fRow As Long
Dim cellA As Variant
Dim cellB As Variant

Set dmr = Worksheets("DMR")
pasteRowIndex = 5
strSearch = InputBox("Please enter 5 digit document number to search for (e.g. 00002):", "Search Value")

With dmr.Range("G3:EP7002")
    Set f = .Find(strSearch, LookIn:=xlValues)
    If Not f Is Nothing Then
        fAddress = f.Address
        Do
            fRow = f.Row
            cellA = dmr.Cells(fRow, 1).Value
            cellD = dmr.Cells(fRow, 4).Value
            Sheets("SEARCH").Cells(pasteRowIndex, 1) = cellA
            Sheets("SEARCH").Cells(pasteRowIndex, 2) = cellD
            pasteRowIndex = pasteRowIndex + 1
            Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> fAddress
    End If
End With

End Sub

Answer 2

由于您只是搜索某个值是否存在，因此您可以使用＆＃34;查找＆＃34;来缩短该代码。特征：

Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim dmrWS As Worksheet, searchWS As Worksheet
Dim lngLstRow As Long, strSearchRow As Long, lngLstCol As Long
Dim strSearch As String
Dim r As Long
Dim x As Variant
Dim searchNewRow As Integer

Set dmrWS = Sheets("DMR")
Set searchWS = Sheets("SEARCH")

strSearch = InputBox("Please enter 5 digit document number to search for (e.g. 00002):", "Search Value")


With dmrWS
    On Error GoTo ErrorHandler
    strSearchRow = .Cells.Find(what:=strSearch, LookAt:=xlWhole).Row
End With

If strSearchRow > 0 Then 'If there was a value found
    searchNewRow = searchWS.UsedRange.Rows.Count
    With searchWS
        .Range(.Cells(searchNewRow, 1), .Cells(searchNewRow, 4)).Value = dmrWS.Range(dmrWS.Cells(strSearchRow, 1), dmrWS.Cells(strSearchRow, 4)).Value
    End With
End If

ErrorHandler:
MsgBox (strSearch & " was not found.")

End Sub

我认为那样做你想要的。如果字符串在＆＃34; DMR＆＃34;中找到表格，在第9行，它将A9：D9复制到＆＃34;搜索＆＃34;中的下一个空行。片。如果这不是您正在寻找的，请告诉我。

Answer 3

我的要求的最终答案，这很有效！

Private Sub CommandButton1_Click()

Dim dmr As Worksheet
Dim strSearch As String
Dim f As Variant
Dim fAddress As String
Dim fRow As Long
Dim cellA As Variant
Dim cellB As Variant

Worksheets("SEARCH").Range("A5:B200").ClearContents

Set dmr = Worksheets("DMR")
pasteRowIndex = 5
strSearch = InputBox("Please enter 5 digit document number to search for (e.g. 00002):", "Search Value")

If strSearch = vbNullString Then
MsgBox ("User canceled, or did not enter a value.")
Exit Sub
End If

With dmr.Range("G3:EP7002")
    Set f = .Find(strSearch, LookIn:=xlValues)
    If Not f Is Nothing Then
        fAddress = f.Address
        Do
            fRow = f.Row
            cellA = dmr.Cells(fRow, 1).Value
            cellD = dmr.Cells(fRow, 4).Value
            Sheets("SEARCH").Cells(pasteRowIndex, 1) = cellA
            Sheets("SEARCH").Cells(pasteRowIndex, 2) = cellD
            pasteRowIndex = pasteRowIndex + 1
            Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> fAddress
    End If

If f Is Nothing Then
MsgBox ("The document number you've entered either does not appear in this tool, or is not cross referenced in any other document.")
Exit Sub
End If
End With
End Sub

VBA：如何从Sheet“DMR”中找到搜索值，然后从A列中找到的搜索值行复制单元格和D列中的单元格查找“搜索”

3 个答案: