|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
珠玉在前,我也写一个
- Sub test()
- Dim arr, brr(), crr, fac$, edr&, i&, j&, k&
- arr = Worksheets(2).Range("A1").CurrentRegion
- crr = Worksheets(3).Range("A1").CurrentRegion
- fac = UCase(Worksheets(1).Range("C1").Value)
- edr = Range("A4").End(xlDown).Row
- '''''设置C1下拉框''''''''''''''''''
- With [C1].Validation
- .Delete
- .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
- xlBetween, Formula1:="=表3!$A$2:$A$99"
- End With
- If edr > 8 Then Range("A9:J" & edr + 1).Clear
- '''匹配''''
- For i = 1 To UBound(crr)
- If fac = crr(i, 1) Then Worksheets(1).Range("C4").Value = crr(i, 2)
- Next i
- ''''数据导入'''''''''''
- For i = 2 To UBound(arr)
- If arr(i, 10) = fac Then
- ReDim Preserve brr(1 To 10, 1 To i)
- k = k + 1
- For j = 1 To 9
- brr(1, k) = k
- brr(j + 1, k) = arr(i, j)
- Next j
- Else
- End If
- Next i
- Worksheets(1).Range("A9").Resize(UBound(brr, 2), 10) = Application.Transpose(brr)
- '''''格式调整'''''
- edr = Range("A4").End(xlDown).Row
- Range("A8:J" & edr + 1).Borders.LineStyle = 1
- Range("A" & edr + 1 & ":B" & edr + 1).Merge
- With Range("A" & edr + 1)
- .Value = "合计"
- .HorizontalAlignment = xlCenter
- End With
- Range("G" & edr + 1) = "=sum(G9:G" & edr & ")"
- Range("H" & edr + 1) = "=sum(H9:H" & edr & ")"
- Range("J" & edr + 1) = "=sum(J9:J" & edr & ")"
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|