|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
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)
If Len(arr(j, 9)) = 0 Then
' d1(arr(j, 9)) = d1(arr(j, 9)) + arr(j, 5) + arr(j, 6) + arr(j, 7)
' d2(arr(j, 9)) = arr(j, 11) + d2(arr(j, 9))
arr(j, 9) = arr(j - 1, 9)
End If
d1(arr(j, 9)) = d1(arr(j, 9)) + arr(j, 8) + arr(j, 6) + arr(j, 7)
d2(arr(j, 9)) = arr(j, 11) + d2(arr(j, 9))
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
|
评分
-
1
查看全部评分
-
|