|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count <> 1 Then Exit Sub
If Target.Column <> 9 Then Exit Sub
arr = ActiveSheet.UsedRange
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
For j = 2 To UBound(arr)
d1(arr(j, 9)) = arr(j, 5) + arr(j, 6) + arr(j, 7)
d2(arr(j, 9)) = arr(j, 11)
Next j
Sheets("日利润").Range("a2:e" & 1000).ClearContents
If d1.Count > 0 Then
With Sheets("日利润")
For j = 1 To d1.Count
.Cells(j + 1, 1) = j
Next j
.Cells(2, 2).Resize(d1.Count) = WorksheetFunction.Transpose(d1.keys)
.Cells(2, 3).Resize(d1.Count) = WorksheetFunction.Transpose(d1.items)
.Cells(2, 4).Resize(d1.Count) = WorksheetFunction.Transpose(d2.items)
.Range("a2:e" & d1.Count + 1).Borders.LineStyle = xlContinuous
End With
End If
End Sub |
|