楼主
wcymiss |
Q：如何将报表分区、分城市，按日期自动显示？如图：
将底表的数据，分区、分城市在对应的表格里，按照选择的日期，自动显示。
A：vba代码如下：
- Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
- If Target.Count > 1 Then Exit Sub
- If Target.Row > 2 Or Target.Column > 1 Or Sh.Name = "底表" Then Exit Sub
- Application.EnableEvents = False
- Dim d, arr, i&, j&, ys, ym, brr(), dk, ddk
- Set d = CreateObject("scripting.dictionary")
- ys = Sh.Cells(1, 1): ym = Sh.Cells(2, 1)
- arr = Sheets("底表").Cells(1, 1).Resize(Sheets("底表").Cells(Rows.Count, 1).End(3).Row, Sheets("底表").Cells(1, Columns.Count).End(1).Column)
- For i = 3 To UBound(arr, 2)
- If Not d.exists(arr(1, i) & Chr(10) & arr(2, i)) Then Set d(arr(1, i) & Chr(10) & arr(2, i)) = CreateObject("scripting.dictionary")
- For j = 5 To UBound(arr)
- If arr(j, 2) <> "" Then
- If Replace(arr(j, 1), "月", "") * 1 >= ys And Replace(arr(j, 1), "月", "") * 1 <= ym Then
- d(arr(1, i) & Chr(10) & arr(2, i))(arr(j, 2)) = d(arr(1, i) & Chr(10) & arr(2, i))(arr(j, 2)) + arr(j, i)
- End If
- End If
- Next
- Next
- dk = Filter(d.keys, Sh.Name)
- If UBound(dk) > -1 Then
- ReDim brr(1 To d(dk(0)).Count + 2, 1 To UBound(dk) + 2)
- For i = 1 To UBound(brr, 2)
- For j = 1 To UBound(brr)
- If i = 1 And j > 2 Then
- ddk = d(dk(i - 1)).keys
- brr(j, i) = ddk(j - 3)
- ElseIf j < 3 And i > 1 Then
- brr(j, i) = Split(dk(i - 2), Chr(10))(j - 1)
- ElseIf i > 1 And j > 2 Then
- brr(j, i) = d(dk(i - 2))(ddk(j - 3))
- End If
- Next
- Next
- End If
- Application.ScreenUpdating = False
- Sh.[b1].Resize(Rows.Count, Columns.Count - 1).ClearContents
- Sh.[b1].Resize(UBound(brr), UBound(brr, 2)) = brr
- Application.ScreenUpdating = True
- Set d = Nothing
- Application.EnableEvents = True
- End Sub
 报表.rar
|