|
Sub CX()
ReDim brr(1 To 1000, 1 To 9)
For Each sht In Sheets
If sht.Name <> ActiveSheet.Name Then
With sht
r = .Cells(.Rows.Count, 1).End(3).Row
arr = .Range("a2:v" & r)
End With
For i = 1 To UBound(arr)
If arr(i, 20) = [d1] Or InStr(arr(i, 20), [f1]) > 0 Then
m = m + 1
For j = 1 To UBound(arr, 2)
brr(m, j) = arr(i, j)
Next
End If
Next
End If
Next
If m > 0 Then
Range("a3:i" & Rows.Count).ClearContents
[a3].Resize(m, 22) = brr
Else
MsgBox "没有找到相关数据,请查证!"
End If
End Sub
前辈,你好!
brr(m, j) = arr(i, j) 提示我说这段 下标越界,是什么原因呢 |
|