| |
ichinose さん、皆さん 今晩は。
>ですねえ！！、実は、最初に使ったのがCollectionだったので
>愛着と言うか・・。
ということは、Collection で、結構、集計をしていたってことですね。
>でも、Dictionaryより、優れている点は？と
>探してみてもないんですよねえ・・
>でも、MacでCollectionが使用可能なら
>WinとMacまでの互換性を考慮した場合、
>
>Collectionを使うことの意義が確認できるので
>これは、結果を待ちたいですね！！
ということで、
MAC で Collection が使えるか待っていたんですが、待ちきれずに、
Collection 用に改造してみました。
それから、自分のスキルアップのために。
あー、初めて、Collection を使って集計してしまった。
どなたか、MAC の Excel で、この Collection版が使えるかどうか確認してみてください。
(まだ、サンさんが見ていたら、お友だちに確認してもらってください。)
Sub Collection集計()
Dim vnt, a, c
Dim i As Long
Dim MyColl As New Collection
'
With Sheets("Sheet1")
vnt = .Range("G2", .Range("A65536").End(xlUp)).Value
End With
'
On Error Resume Next
For i = 1 To UBound(vnt, 1)
'Collectionにkey ,Itemを追加
MyColl.Add Item:= _
Array(vnt(i, 1), vnt(i, 2), vnt(i, 3), vnt(i, 4), _
vnt(i, 5), vnt(i, 6), vnt(i, 7)), key:=vnt(i, 1)
If Err.Number <> 0 Then
'重複のとき
a = MyColl(vnt(i, 1))
MyColl.Remove vnt(i, 1)
a(4) = a(4) + vnt(i, 5) '集計
a(5) = a(5) + vnt(i, 6)
a(6) = a(6) + vnt(i, 7)
MyColl.Add Item:=a, key:=vnt(i, 1)
End If
Err.Number = 0
Next
On Error GoTo 0
'
'-----出力用配列を作成
i = 1
ReDim outvnt(1 To MyColl.Count)
For Each c In MyColl
outvnt(i) = c
i = i + 1
Next
'
'-----結果出力
With Sheets("Sheet2")
.Cells.ClearContents
.Range("A1:G1").Value = Sheets("Sheet1").Range("A1:G1").Value
.Range("A2").Resize(MyColl.Count, UBound(vnt, 2)).Value = _
Application.Transpose(Application.Transpose(outvnt))
.Select
End With
'
Erase vnt: Erase outvnt
For i = 1 To MyColl.Count
MyColl.Remove 1
Next
End Sub
|
|
kobasan
- 06/7/24(月) 20:16 -
