|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub gj23w98()
- Set d = CreateObject("Scripting.Dictionary")
- arr = Sheet2.[a1].CurrentRegion
- For i = 2 To UBound(arr)
- d(arr(i, 2)) = arr(i, 5)
- Next
- brr = Sheet8.[a1].CurrentRegion
- ReDim br1(1 To UBound(brr), 1 To UBound(brr, 2)), br2(1 To UBound(brr), 1 To UBound(brr, 2))
- For i = 2 To UBound(brr)
- brr(i, 3) = d(brr(i, 2))
- Next
- Sheet8.[a1].CurrentRegion = brr
- For i = 2 To UBound(brr)
- If InStr(brr(i, 3), "上") Then
- m = m + 1
- For j = 1 To UBound(brr, 2)
- br1(m, j) = brr(i, j)
- Next
- Else
- n = n + 1
- For j = 1 To UBound(brr, 2)
- br2(n, j) = brr(i, j)
- Next
- End If
- Next
- If m Then
- [a1].CurrentRegion.Offset(1).ClearContents
- [a2].Resize(m, UBound(br1, 2)) = br1
- End If
- If n Then
- [e1].CurrentRegion.Offset(1).ClearContents
- [e2].Resize(n, UBound(br2, 2)) = br2
- End If
- crr = Sheet9.UsedRange
- ReDim cr1(1 To UBound(crr), 1 To UBound(crr, 2)), cr2(1 To UBound(crr), 1 To UBound(crr, 2))
- For i = 2 To UBound(crr)
- crr(i, 5) = d(crr(i, 2))
- Next
- Sheet9.UsedRange = crr
- For i = 2 To UBound(crr)
- If InStr(crr(i, 5), "上") Then
- p = p + 1
- For j = 1 To UBound(crr, 2)
- cr1(p, j) = crr(i, j)
- Next
- Else
- q = q + 1
- For j = 1 To UBound(crr, 2)
- cr2(q, j) = crr(i, j)
- Next
- End If
- Next
- If m Then
- Range("i2:m" & Rows.Count).ClearContents
- [i2].Resize(p, UBound(cr1, 2)) = cr1
- End If
- If n Then
- Range("o2:s" & Rows.Count).ClearContents
- [o2].Resize(q, UBound(cr2, 2)) = cr2
- End If
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|