- ©«¤l
- 2839
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2895
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-12-27
|
°ò¥»¦r¨åÀ³¥Î..¤§«e«Ü¦h°Ý©«³£¦³¥Î¹L, ¥i¨£ÁÙ¬O¨S¦³¥Î¤ß¥h²z¸Ñ//
¦³¨Ç°ÝÃDÁÙ¬O¥i¥H¦Û¦æ¥h¸Ñ¨Mªº///
Sub Test_a1()
Dim Arr, xD, T$, i&, j&, N&
Sheets("Result").UsedRange.Offset(10).EntireRow.Delete
[Result!a10:i10] = ""
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Data!i1], [data!a65536].End(3))
For i = 10 To UBound(Arr)
If Not IsNumeric(Arr(i, 1) & "") Then GoTo i01
T = Arr(i, 2) & "\" & Arr(i, 4) & "\" & Arr(i, 5)
If xD(T) = 0 Then
N = N + 1: xD(T) = N: Arr(N, 1) = N
For j = 2 To UBound(Arr, 2): Arr(N, j) = Arr(i, j): Next
Else
j = xD(T)
Arr(j, 6) = Arr(j, 6) + Arr(i, 6)
Arr(j, 8) = Arr(j, 8) + Arr(i, 8)
End If
i01: Next i
If N = 0 Then Exit Sub
With [Result!a10:i10].Resize(N)
.Rows(1).Copy .Cells
.Value = Arr
.Columns(2).Resize(, 8).Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlNo
End With
End Sub |
|