|
发表于 2017-8-2 14:30
|
显示全部楼层
本楼为最佳答案
- Sub tt()
- arr = Sheets(2).Range("a1:i" & Sheets(2).[a65536].End(3).Row)
- ReDim brr(1 To UBound(arr), 1 To 9)
- gs = [c1]
- If Len(gs) = 0 Then MsgBox "请输入公司名称": Exit Sub
- For i = 2 To UBound(arr)
- If arr(i, 1) = gs Then
- n = n + 1
- brr(n, 1) = n
- brr(n, 2) = arr(i, 3)
- brr(n, 3) = ""
- brr(n, 4) = arr(i, 4)
- brr(n, 5) = arr(i, 5)
- brr(n, 6) = arr(i, 7)
- brr(n, 7) = arr(i, 8)
- brr(n, 8) = arr(i, 9)
- brr(n, 9) = arr(i, 7) * arr(i, 9)
- s = s + brr(n, 9)
- End If
- Next
- If n = 0 Then MsgBox gs & "无匹配记录": Exit Sub
- With Sheets(1)
- r = .[a65536].End(3).Row
- If r > 6 Then .Rows(3).Resize(r - 6).Delete
- .[a3:i4] = ""
- If n > 2 Then .Rows(4).Resize(n - 2).Insert
- .[a3].Resize(n, 9) = brr
- For i = 1 To n
- .Cells(i + 2, 2).Resize(, 2).Merge
- Next
- .Cells(n + 3, 4) = s
- End With
- End Sub
复制代码 |
|