小福利，用Excel VBA设计一个查询小应用

小福利，用Excel VBA设计一个查询小应用

Option Explicit

Sub 查询_Click()
    Dim rng1, rng2, rng As Range
    Dim firstaddress
    Dim a As Integer
    a = 4
    Sheets("查询").Range(Cells(4, "b"), Cells(Sheets("查询").UsedRange.Rows.Count, "e")).Delete
    With Sheets("交底书").Range("A:D")
        Set rng1 = .Find(Sheets("查询").Cells(2, 2).Text, lookat:=xlPart)

        If Not rng1 Is Nothing Then
            firstaddress = rng1.Address
            Do
                
                If InStr(rng1, Sheets("查询").Cells(2, 3)) > 0 And InStr(rng1, Sheets("查询").Cells(2, 4)) > 0 Then
                           
                    Range("B" & a) = "=交底书!$A$" & Right(rng1.Address, Len(rng1.Address) - 3)
                    Range("C" & a) = "=交底书!$B$" & Right(rng1.Address, Len(rng1.Address) - 3)
                    Range("D" & a) = "=交底书!$C$" & Right(rng1.Address, Len(rng1.Address) - 3)
                    Range("E" & a) = "=交底书!$D$" & Right(rng1.Address, Len(rng1.Address) - 3)
                    

                    Range("D" & a).Hyperlinks.Add Anchor:=Range("D" & a), Address:="", SubAddress:= _
        "交底书!C" & Right(rng1.Address, Len(rng1.Address) - 3)
                    Range("E" & a).Hyperlinks.Add Anchor:=Range("E" & a), Address:="", SubAddress:= _
        "交底书!D" & Right(rng1.Address, Len(rng1.Address) - 3)
                    a = a + 1
                          
                End If
                Set rng1 = .FindNext(rng1)
                If rng1 Is Nothing Then
                    GoTo DoneFinding
                End If
                    
            Loop While rng1.Address <> firstaddress
        End If
DoneFinding:
    End With
    MsgBox ("共查出" & (Sheets("查询").UsedRange.Rows.Count - 3) & "条记录")
    
    
    
   
End Sub
Sub 清空_Click()
    
    
     Sheets("查询").Range(Cells(4, "b"), Cells(Sheets("查询").UsedRange.Rows.Count, "e")).Delete
    
    
End Sub