| |
Dictionaryを使った一例です？
UserFormに以下のコントロールが配置されています
ComboBox1〜4
CommandButton1
以下のコードをUserFormのコードモジュールに記述して下さい
Option Explicit
'UserFormモジュール内の何処からでも参照出来る定数、変数を宣言
'Listの列数(A列〜F列)
Const clngColumns As Long = 6
'集計列の先頭位置(基準位置rngListから「数量」の列Offset)
Const clngSum As Long = 3
'Listの基準セル(「取引先名」の位置)
Private rngList As Range
'Listの行数
Private lngRows As Long
'出力先の基準セル(列見出し先頭の位置)
Private rngResult As Range
'集計項目名、位置、表示の配列(表示Table用配列)
Private vntList As Variant
Private Sub UserForm_Activate()
If lngRows = 0 Then
MsgBox "データが有りません", vbExclamation
Unload Me
End If
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim vntData As Variant
Dim vntItems As Variant
Dim vntPos As Variant
'Listの基準セルを設定(「取引先名」の位置)
Set rngList = Worksheets("Sheet1").Cells(1, "A")
'出力先の基準セルを設定(列見出し先頭の位置)
Set rngResult = Worksheets("Sheet2").Cells(1, "A")
'Listの列数取得
With rngList
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRows < 1 Then
lngRows = 0
End If
'列見出しを取得
vntData = .Resize(, clngColumns).Value
End With
'ComboBox1の設定
'表示する列の位置を設定(基準セルからの列Offset)
vntPos = Array(0, 1, 2)
'ItemListを作成
ReDim vntItems(UBound(vntPos), 1)
For i = 0 To UBound(vntPos)
vntItems(i, 0) = vntData(1, vntPos(i) + 1)
vntItems(i, 1) = vntPos(i)
Next i
With ComboBox1
'Itemを設定
.List = vntItems
'表示列を1列に
.ColumnCount = 1
End With
'ComboBox1以外の設定
'表示する列の位置を設定(clngSumからの列Offset)
vntPos = Array(0, 1, 2)
'表示Table用配列を作成
ReDim vntList(1 To UBound(vntPos) + 1, 1 To 3)
For i = 1 To UBound(vntList, 1)
'列見だしを代入
vntList(i, 1) = vntData(1, vntPos(i - 1) + clngSum + 1)
'配列の2列目に-1を代入
vntList(i, 2) = -1
'配列の3列目に列位置を代入
vntList(i, 3) = vntPos(i - 1)
Next i
End Sub
Private Sub UserForm_Terminate()
Set rngList = Nothing
Set rngResult = Nothing
End Sub
Private Sub CommandButton1_Click()
' 集計
Dim i As Long
Dim j As Long
Dim lngIndex As Long
Dim dicIndex As Object
Dim vntKeys As Variant
Dim vntData As Variant
Dim lngPos() As Long
Dim vntResult As Variant
Dim vntHeader As Variant
'ComboBox1の値が選択されていない場合
ReDim lngPos(0)
With ComboBox1
If .ListIndex = -1 Then
'Subを抜ける
GoTo Wayout
Else
'Keyの列位置を取得
lngPos(0) = Val(.List(.ListIndex, 1))
End If
End With
'ComboBox1以外の値が１つも選択されていない場合
For i = 2 To 4
With Controls("ComboBox" & i)
If .ListIndex > -1 Then
'集計列位置を取得
j = j + 1
ReDim Preserve lngPos(j)
lngPos(j) = Val(.Tag)
End If
End With
Next i
'ComboBox1以外の値が１つも選択されていない場合
If UBound(lngPos) = 0 Then
'Subを抜ける
GoTo Wayout
End If
'結果シートをクリア
rngResult.Parent.Cells.Clear
'結果出力用配列、データ用配列を確保
ReDim vntResult(lngRows, UBound(lngPos)), _
vntData(1 To UBound(lngPos))
'Key及び集計データを取得
With rngList
'Keyデータを配列に取得
vntKeys = .Offset(1, lngPos(0)).Resize(lngRows + 1).Value
'選択された集計列の集計値を配列に取得
For i = 1 To UBound(lngPos)
vntData(i) = .Offset(1, clngSum _
+ lngPos(i)).Resize(lngRows + 1).Value
Next i
End With
'列見出しを結果出力用配列に代入
vntResult(0, 0) = ComboBox1.Text
j = 0
For i = 2 To 4
With Controls("ComboBox" & i)
If .ListIndex > -1 Then
j = j + 1
vntResult(0, j) = .Text
End If
End With
Next i
'Dictionaryオブジェクトを取得
Set dicIndex = CreateObject("Scripting.Dictionary")
'集計
With dicIndex
For i = 1 To lngRows
'DictionaryにKeyが有った場合
If .Exists(vntKeys(i, 1)) Then
'結果配列に集計値を加算
For j = 1 To UBound(lngPos)
vntResult(.Item(vntKeys(i, 1)), j) _
= vntResult(.Item(vntKeys(i, 1)), j) _
+ vntData(j)(i, 1)
Next j
Else
'DictionaryにKeyと結果配列に列位置を登録
lngIndex = lngIndex + 1
.Item(vntKeys(i, 1)) = lngIndex
'結果配列にKeyと集計値を代入
vntResult(lngIndex, 0) = vntKeys(i, 1)
For j = 1 To UBound(lngPos)
vntResult(lngIndex, j) = vntData(j)(i, 1)
Next j
End If
Next i
End With
'結果を出力
rngResult.Resize(lngIndex + 1, _
UBound(lngPos) + 1).Value = vntResult
Wayout:
Set dicIndex = Nothing
End Sub
Private Sub ComboBox2_Enter()
SetCombList ComboBox2
End Sub
Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ItemSelecte ComboBox2
End Sub
Private Sub ComboBox3_Enter()
SetCombList ComboBox3
End Sub
Private Sub ComboBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ItemSelecte ComboBox3
End Sub
Private Sub ComboBox4_Enter()
SetCombList ComboBox4
End Sub
Private Sub ComboBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ItemSelecte ComboBox4
End Sub
Private Sub SetCombList(cmbControl As MSForms.ComboBox)
' ComboBoxのListを設定
Dim i As Long
Dim j As Long
Dim strItem As String
'ComboBoxに就いて
With cmbControl
'現在のValueを保存
strItem = .Value
'クリア
.Clear
'配列の行全てを繰り返す
For i = 1 To UBound(vntList, 1)
'もし、配列の2列目が0若しくは、自分の番号なら
If vntList(i, 2) = -1 _
Or vntList(i, 2) = .TabIndex Then
'Listに配列に1列目を設定
.AddItem vntList(i, 1)
'もし、配列の2列目に自分の番号が有ったら
If vntList(i, 2) = .TabIndex Then
'その番号を0にする
vntList(i, 2) = -1
End If
End If
Next i
.Value = strItem
End With
End Sub
Private Sub ItemSelecte(cmbControl As MSForms.ComboBox)
' 選択されたItmeを配列に登録
Dim i As Long
'ComboBoxに就いて
With cmbControl
'選択されたItemを配列に登録
If .ListIndex > -1 Then
'配列の行全てを繰り返す
For i = 1 To UBound(vntList, 1)
'もし、配列の1列目に選択された値が有ったら
If vntList(i, 1) = .List(.ListIndex, 0) Then
'その値の番号をTabIndexの値にする
vntList(i, 2) = .TabIndex
'Tagに列位置を登録
.Tag = vntList(i, 3)
'Forを抜ける
Exit For
End If
Next i
Else
'Tagをクリア
.Tag = Empty
End If
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
