Scripting.Dictionaryについて
オートフィルタで抽出した値をリストボックスに代入する為の
コードがあります。
前任者が書いたコードですが、何とか動作を確認しながら
変更しようとしたのですが、わかりませんでした。
やりたいこと
Application.Intersect(SS, SS.Offset(1)).Copyからxに格納した
値をmyList(i, 1) = xでリストボックスに入れたい。
問題点
For i = 0 To UBound(v) - 1
.Item(v(i)) = .Item(v(i)) + 1 'アイテムのカウント
Next
上記の後に
For Each v In .Keys
i = i + 1
myList(i, 0) = v '8行目の値
myList(i, 1) = x '9行目の値を入れたい
myList(i, 2) = .Item(v) '8行目のカウント数
Next
が実行される際にvの値が重複を除いて、順番にリストに
入る動作が理解できません。
どなたかアドバイスお願いします。
Private Sub ComboBox1_Change()
Dim 開始日 As Date
Dim 終了日 As Date
Dim i, ii As Long, v, x As Variant
Dim Sh1 As Worksheet
Set Sh1 = Sheets("日報")
Set RR = Sh1.Range("A4").CurrentRegion
Set CC = RR.Columns(8)
Set SS = RR.Columns(9)
開始日 = DateValue(ComboBox1.Value)
終了日 = DateSerial(Year(開始日), Month(開始日) + 1, Day(開始日)) - 1
RR.Worksheet.AutoFilterMode = False ' B列 開始日から月末までの期間を抽出
RR.AutoFilter Field:=1, _
Criteria1:=">=" & 開始日, Operator:=xlAnd, _
Criteria2:="<=" & 終了日
Application.Intersect(CC, CC.Offset(1)).Copy '8行目をコピー
With New DataObject
.GetFromClipboard
v = Split(.GetText, vbCrLf) 'vに代入
Application.Intersect(SS, SS.Offset(1)).Copy '9行目をコピー
.GetFromClipboard
x = Split(.GetText, vbCrLf) 'xに代入
End With
With CreateObject("Scripting.Dictionary")
For i = 0 To UBound(v) - 1
.Item(v(i)) = .Item(v(i)) + 1 'アイテムのカウント
Next
ReDim myList(1 To .Count, 2)
i = 0
For Each v In .Keys
i = i + 1
myList(i, 0) = v '8行目の値
myList(i, 1) = x '9行目の値を入れたい
myList(i, 2) = .Item(v) '8行目のカウント数
Next
ListBox1.ColumnCount = 3
ListBox1.List = myList()
End With
RR.Worksheet.AutoFilterMode = False
RR.Worksheet.Application.CutCopyMode = False
End Sub
お礼
お返事ありがとうございます。 今回はこの方法を見つけたので、この方法でやりました。 Tx_Day(1) = Tx_Day_1 Tx_Day(2) = Tx_Day_2 for i=1 to 2 Tx_Day(i).text = "" next Nextの横につける[i]にはそういう意味があったのですね知りませんでした。