|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub db()
Dim brr()
arr = Sheets("生产记录").Range("b5:r" & Range("c" & Rows.Count).End(3).Row)
s = [c3]
n = 0
If s = "" Then
Range("b6:q" & Range("b" & Rows.Count).End(3).Row).ClearContents
Exit Sub
End If
For i = 1 To UBound(arr)
For j = 2 To 6
If InStr(arr(i, j), s) >= 1 Then
n = n + 1
ReDim Preserve brr(1 To 16, 1 To n)
For k = 1 To 16
brr(k, n) = arr(i, k)
Next
Exit For
End If
Next
Next
Range("b6:q" & [b65536].End(3).Row).ClearContents
If n > 0 Then [b6].Resize(n, 16) = Application.Transpose(brr)
Dim brr1()
arr1 = Sheets("sheet3").Range("a2:f1000")
If s = "" Then
Range("x6:ad1000").ClearContents
Exit Sub
End If
n1 = 0
For i1 = 1 To UBound(arr1)
For j1 = 2 To 6
If InStr(arr1(i1, j1), s) >= 1 Then
n1 = n1 + 1
ReDim Preserve brr1(1 To 6, 1 To n1)
For k1 = 1 To 6
brr1(k1, n1) = arr1(i1, k1)
Next
Exit For
End If
Next
Next
Range("x6:ad1000").ClearContents
If n1 > 0 Then [x6].Resize(n1, 6) = Application.Transpose(brr1)
End Sub
|
评分
-
1
查看全部评分
-
|