以下代碼只能查找關鍵字所在行，如何修改可以查找所在行以及所在行的下面四行
Sub test()
Dim Arr, Brr
Dim Srr(1 To 10000, 1 To 12)
Dim D As Object
Set D = CreateObject("scripting.dictionary")
Set wb = GetObject(ThisWorkbook.Path & "\" & "aaa.xlsx")
With wb.Sheets("清單")
Arr = .Range("A3:L" & .[B3].End(xlDown).Row)
End With
With Sheets("查找")
Brr = .Range("A2:B2")'a2：b2查詢單元格為a2:b2
End With
For J = 1 To UBound(Brr, 2)
If Brr(1, J) <> "" Then
N = N + 1
D(N) = J
End If
Next
If N = 0 Then
MsgBox "請輸入條件"
Exit Sub
End If
For I = 1 To UBound(Arr)
K = 0
For J = 1 To N
If Arr(I, D(J)) Like "*" & Brr(1, D(J)) & "*" Then K = K + 1
Next
If K = N Then
S = S + 1
For J = 1 To UBound(Arr, 2)
Srr(S, J) = Arr(I, J)
Next
End If
Next
With Sheets("查找")
.Range("A5:L10000").Clear
If S = 0 Then
MsgBox "查無"
Exit Sub
End If
.[A5].Resize(S, 12) = Srr
MsgBox "查詢成功"
End With
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/28634.html
標籤：VBA
上一篇：vb.net