Question

如果有人能帮我解决以下问题，我将非常感激：

我想在一个非常大的数据库中搜索文本（使用Textbox）。（例如搜索：铁）。我期待的结果如下：“红铁”，“铁灰色”，“非常长铁”+将整行复制到另一张纸（带文本框名称）并找到最低价格范围（D2：J）。 D1，E1，F1，G1，H1，I1，J1是供应商。如果可能，我想在msgbox中显示供应商名称和最低价格。

我想在范围A：A中搜索。

有人可以帮我这个吗？

非常感谢， Ñ

Answer 1

如果你自己没有尝试任何编码，可以帮助你开始......

.1）您可以给自己一个Userform来输入所需的术语（您应该能够自己制作Userform）。确保将该术语保存在代码之外，以便您可以执行它（如果您为每个部分编写多个宏）：

Public burp as Text
Sub 
    Set burp = Userform(1).Textbox(1).Value 'Will need to tweak
End Sub

Sub NameOfNextSub()

.2）我没有玩Find功能，但是我做了类似于你想要循环和匹配的东西。如果匹配，则将匹配的行粘贴到另一个表的末尾

Dim LR as Long
LR = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

For i = 1 to LR
    If IsError(WorkSheetFunction.Match(*burp*,cells(i,2)),0)>0 Then
        Sheets("Sheet1").Row(i).Copy
        Sheets("Sheet2").Row(i).PasteSpecial xlPasteValues
        Else:
        End If
Next i
Delete_Empty_Rows 'runs macro named "Delete_Empty_Rows"

谷歌删除空行......你应该获得大量的点击，以不同的方式行事;挑选最适合自己的。确保它在Sheet2上运行。

这是一种非常懒惰的做法，但它会起作用。

.3）过滤Sheet2基于任何列的成本，xlAscending。再次，快速谷歌。看起来像是：

Columns("A:C").Sort key1:=Range("C2"), _
  order1:=xlAscending, header:=xlNo

.4）由于您知道最低价格将位于第一行，并且您知道该列，因此您可以显示一个消息框以显示该单元格中的内容：

MsgBox "Lowest price: "&Cells(1,4)

这应该让你准备好在VBA中编写你想要的代码。

Answer 2

`Private Sub SearchCommandButton_Click()
`Dim searchitem As Variant
`Dim lr As Long
`Dim WSNew As Worksheet
`Dim sheetname As String

`Set searchitem = SearchUserForm.TextBox1.Value
`lr = Cells(Sheets("GC").Rows.Count, 1).End(xlUp).Row
`For i = 1 To lr
`If IsError(WorksheetFunction.Match(searchitem, Cells(i, 2)), 0) > 0 Then
`Sheets("GC").Row(i).Copy
`Else
`Set WSNew = Worksheets.Add(After:=Sheets(ActiveSheet.Index))

    sheetname = searchitem

    On Error Resume Next

    WSNew.Name = sheetname
    If Err.Number > 0 Then
        MsgBox "We cannot match the search: " & WSNew.Name & _
             " Please try again" & _
             " Sheet already exist!" & _
             " The sheet name cannot contain this!"
        Err.Clear
    End If
    On Error GoTo 0

    With WSNew.Range("A1")

        .PasteSpecial Paste:=8
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        .Select
    End With

End If

结束Sub`

Answer 3

我尝试了另一种编码。这个是识别我正在寻找复制并粘贴到现有工作表的文本。清除宏开头的内容。

`Private Sub SearchCommandButton_Click()
Dim rFind As Range
Dim rCopy As Range
Dim strSearch As String
Dim sFirstAddress As String
Dim destsh As Worksheet

Sheets("comparelist").Activate
Sheets("comparelist").Range("A2:AA200").ClearContents
strSearch = TextBox1.Value
Set rCopy = Nothing

Application.ScreenUpdating = False

With Sheets("GC").Columns("A:A")
Set rFind = .Find(strSearch, LookIn:=xlValues, Lookat:=xlPart,SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then sFirstAddress = rFind.Address
    Do
        If rCopy Is Nothing Then
            Set rCopy = rFind
        Else
            Set rCopy = Application.Union(rCopy, rFind)
        End If
        Set rFind = .FindNext(rFind)
    Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress

    rCopy.EntireRow.Copy
    Sheets("comparelist").Activate
    Sheets("comparelist").Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.ScreenUpdating = True
Unload Me
Sheets("comparelist").Range("A1").Select

End If
End With
End Sub

我接下来要做的是比较每个项目中D，I，N和R列的值，最低值为黄色，最大值为红色。有人可以帮忙吗？

非常感谢！ N.

搜索范围中的文本并显示包含文本的所有行 - VBA

3 个答案: