- ©«¤l
- 2833
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2889
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-11-16
|
¦³ÂI½ÆÂø, ¦Û¦æ°Ñ°u~~
- Sub TEST()
- Dim Arr, xD(3), d1, d2, i&, j&, k%, U%, Ur, Srr, xS As Worksheet
- For j = 0 To 3: Set xD(j) = CreateObject("Scripting.Dictionary"): Next j
- Arr = [L2:M30]
- For j = 1 To 2: For i = 1 To UBound(Arr)
- If Arr(i, j) <> "" Then xD(0)(Arr(i, j)) = j
- Next: Next
- '--------------------------------
- Arr = Range([J1], Cells(Rows.Count, 1).End(xlUp))
- For i = 2 To UBound(Arr)
- d1 = Arr(i, 3): d2 = Arr(i, 4)
- If IsDate(d1) * IsDate(d2) = 0 Then GoTo 101
- U = xD(0)(Arr(i, 2)) + 1
- For j = d1 To d2 - 1
- Ur = xD(U)(j)
- If Not IsArray(Ur) Then Ur = Array(CDate(j), 0, 0, 0, 0, 0, 0)
- For k = 5 To 10: Ur(k - 4) = Ur(k - 4) + Arr(i, k): Next k
- xD(U)(j) = Ur
- Next j
- 101: Next i
- '--------------------------------
- Srr = Array("", "¤@¯ë", "¯S®í1", "¯S®í2")
- For k = 1 To 3
- With Sheets(Srr(k))
- .UsedRange.Offset(1, 0).EntireRow.Delete
- U = xD(k).Count: If U = 0 Then GoTo 102
- With .[B2:H2].Resize(U)
- .Value = Application.Transpose(Application.Transpose(xD(k).items))
- .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
- End With
- End With
- 102: Next k
- End Sub
½Æ»s¥N½X
Xl0000054.rar (21.99 KB)
============================== |
|