- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 242
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-11-8
|
¥»©«³Ì«á¥Ñ Hsieh ©ó 2012-10-6 17:25 ½s¿è
¦^´_ 1# jessicamsu
¸Õ¸Õ¬Ý- Sub ex()
- Application.DisplayAlerts = False
- Application.ScreenUpdating = False
- Dim Target As Workbook, Sale As Workbook, A As Range, m
- Set dn = CreateObject("Scripting.Dictionary")
- Set dm = CreateObject("Scripting.Dictionary")
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- Set Dic2 = CreateObject("Scripting.Dictionary")
- 10
- m = InputBox("¿é¤J¤ë¥÷", , 8)
- If Val(m) < 1 Or Val(m) > 12 Then GoTo 10
- Set Sale = Workbooks.Open(ThisWorkbook.Path & "\¾P°â¸ê®Æ.xlsx")
- Set Target = Workbooks.Open(ThisWorkbook.Path & "\¥Ø¼Ð¸ê®Æ.xlsx")
- With Sale '¾P°â
- With .Sheets(1)
- For Each A In .Range(.[B2], .[B2].End(xlDown)).SpecialCells(xlCellTypeConstants)
- dm(A.Offset(, 3).Value) = ""
- mystr = A.Value & "," & A.Offset(, -1).Value
- If A.Offset(, 3) = Val(m) Then
- If d(mystr) = "" Then
- d(mystr) = A.Offset(, 1)
- Else
- d(mystr) = IIf(InStr(d(mystr), A.Offset(, 1)) = 0, d(mystr) & "," & A.Offset(, 1), d(mystr))
- End If
- d1(mystr) = d1(mystr) + A.Offset(, 2)
- End If
- dn(mystr) = Array(A.Offset(, -1).Value, A.Value, UBound(Split(d(mystr), ",")) + 1, d1(mystr))
- Next
- End With
- .Close 0
- End With
- With Target '¥Ø¼Ð
- With .Sheets(1)
- For Each A In .Range(.[B2], .[B2].End(xlDown)).SpecialCells(xlCellTypeConstants)
- dm(A.Offset(, 3).Value) = ""
- mystr = A.Value & "," & A.Offset(, -1).Value
- dn(mystr) = Array(A.Offset(, -1).Value, A.Value, UBound(Split(d(mystr), ",")) + 1, d1(mystr))
- Dic2(A.Offset(, -1) & A & "," & A.Offset(, 3)) = A.Offset(, 2)
- Next
- End With
- .Close 0
- End With
- With ActiveSheet
- .UsedRange.EntireColumn.Delete
- .[A1:A2] = "Sales Name": .[B1:B2] = "Bill TO": .[C1:C2] = "«È¤á¼Æ" & Chr(10) & "(" & m & "¤ë)": .[D2] = "¾P°â¶q" & Chr(10) & "(" & m & "¤ë)"
- .[D1:E1] = "¾P°â¹êÁZ": .[F1].Resize(, dm.Count - 1) = "¥Ø¼Ð"
- With .[A3].Resize(dn.Count, 4)
- .Value = Application.Transpose(Application.Transpose(dn.items))
- .Sort key1:=.Cells(1, 2), key2:=.Cells(1, 1), Header:=xlNo
- k = 4
- For Each ky In dm.keys
- ActiveSheet.Cells(2, k + 1) = "(" & ky & "¤ë¥÷)"
- For Each A In .Columns(1).Cells
- mystr = A & A.Offset(, 1) & "," & ky
- A.Offset(, k) = Dic2(mystr)
- Next
- k = k + 1
- Next
- End With
- With .Range("A2").CurrentRegion.Offset(1)
- .Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3, 4, 5, 6, _
- 7), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
- .Cells(1, 1).ClearOutline
- For r = .Rows.Count To 3 Step -1
- Set A = .Cells(r, 2)
- If A = A.Offset(-1, 0) Then Range(A, A.Offset(-1, 0)).Merge
- Next
- End With
- .[A1:A2].Merge
- .[B1:B2].Merge
- .[C1:C2].Merge
- .[D1:E1].Merge
- .[F1].Resize(, dm.Count - 1).Merge
- .UsedRange.SpecialCells(xlCellTypeFormulas).Font.Bold = True
- End With
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End Sub
½Æ»s¥N½X |
|