こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBAの検索で回答をいただいたのですが・・・

Excel2010VBAの検索で、シート1のE列(2行目から)の「日時」とシート2のE列(2行目から)の日時が一致した場合、シート2のF列(2行目から)からJ列(2行目から)、またはJ列にデータがない場合は、F列(2行目から)からI列(2行目から)にデータを入力するというプログラムを高速化する方法を回答者様から教えていただきました。
シートの内容としては
シート1は、A「年」、B「月」、C「日」、D「時刻」、E「日時」(文字列)、F「データ1」、G「データ2」、H「データ3」、I「データ4」、J「データ5」、(1行目はタイトル)
シート2も基本的にはシート1と同じです。
教えていただいたプログラムは以下の通りで、これを元にシート3(シート1と同じ配列)のE列の日時とシート2のE列の日時が一致した行のシート3のF~J列(データ1~データ5)、J列のデータがない場合、F~I列(データ1~データ4)のデータをシート2のK~O列(データ1~データ5)に入力するというプログラムを作りたかったのですが、自分にとってはこのプログラムの内容が理解できないため、どこを修正していいか分かりません。
どなたか解説していただけませんか?



Sub xxx3()
Dim myDic As Object
Dim S1_v, S2_v
Dim i As Long, n As Long, j As Long

'With Workbooks("ブック.xlsm").Worksheets("シート1")
With Sheets("Sheet1")
j = .Range("E" & Rows.Count).End(xlUp).Row
S1_v = .Range("E1").Resize(j, 6).Value '対象範囲を配列に
End With

'With Workbooks("ブック.xlsm").Worksheets("シート2")
With Sheets("Sheet2")
j = .Range("E" & Rows.Count).End(xlUp).Row
S2_v = .Range("E1").Resize(j, 6).Value '対象範囲を配列に
End With

Set myDic = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(S1_v)
myDic.Add S1_v(i, 1), i 'keyに追加、itemにi
Next i

For i = 2 To UBound(S2_v)
If myDic.exists(S2_v(i, 1)) Then
j = myDic.Item(S2_v(i, 1))
S2_v(i, 2) = S1_v(j, 2)
S2_v(i, 3) = S1_v(j, 3)
S2_v(i, 4) = S1_v(j, 4)
S2_v(i, 5) = S1_v(j, 5)
S2_v(i, 6) = S1_v(j, 6)
Else
'マッチしなかったときの処理
End If
Next

'With Workbooks("ブック.xlsm").Worksheets("シート2")
With Sheets("Sheet2")
j = .Range("E" & Rows.Count).End(xlUp).Row
.Range("E1").Resize(j, 6).Value = S2_v
End With

Set myDic = Nothing
Erase S1_v, S2_v

End Sub

回答よろしくお願いします。

投稿日時 - 2012-01-22 07:15:23

QNo.7259147

困ってます

質問者が選んだベストアンサー

前回、回答したものです。

個々の分からないものは、グーグルなどでつぎのような感じで検索してください。
vba Resize
vba Dictionary
vba 配列 シート範囲

データ名やシート名を日本語に変えただけです。

Sub xxx3()
Dim myDic As Object
Dim マスター配列, 修正配列
Dim i As Long, n As Long, j As Long

'With Workbooks("ブック.xlsm").Worksheets("シート2")
With Sheets("マスターシート")
j = .Range("E" & Rows.Count).End(xlUp).Row
マスター配列 = .Range("E1").Resize(j, 6).Value '対象範囲を配列に
'''''マスター配列 = .Range("E1").Resize(j, 11).Value '対象範囲の列数を増やす
End With

'With Workbooks("ブック.xlsm").Worksheets("シート1")
'''''With Workbooks("ブック.xlsm").Worksheets("シート3")に変える
With Sheets("修正シート")
j = .Range("E" & Rows.Count).End(xlUp).Row
修正配列 = .Range("E1").Resize(j, 6).Value '対象範囲を配列に
End With

Set myDic = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(マスター配列)
myDic.Add マスター配列(i, 1), i 'keyに追加、itemにi・・iは行数
Next i

For i = 2 To UBound(修正配列)
If myDic.exists(修正配列(i, 1)) Then
j = myDic.Item(修正配列(i, 1))
マスター配列(j, 2) = 修正配列(i, 2)
'''''マスター配列(j, 7) = 修正配列(i, 2)
マスター配列(j, 3) = 修正配列(i, 3)
マスター配列(j, 4) = 修正配列(i, 4)
マスター配列(j, 5) = 修正配列(i, 5)
マスター配列(j, 6) = 修正配列(i, 6)
Else
'マッチしなかったときの処理
End If
Next

'With Workbooks("ブック.xlsm").Worksheets("シート2")
With Sheets("マスターシート")
j = .Range("E" & Rows.Count).End(xlUp).Row
.Range("E1").Resize(j, 6).Value = マスター配列
End With

Set myDic = Nothing
Erase マスター配列, 修正配列

End Sub

投稿日時 - 2012-01-22 11:47:32

お礼

回答ありがとうございます。

いろいろ調べて、だいたいというか何となくの流れは分かりました。
また、ほかのセルに入力するためにどこの変数を変えていいかも分かりました。
ki-aaaさんのおっしゃるとおり、調べてみようと思っています。
また、いまだ完全ではないのでもう少し勉強をしたいと思います。

ki-aaaさんのおかげで処理時間が全然違いました。
自分が作ったものは次の日になっても終わらず困っていました。
大変感謝しております。本当にありがとうございました。

投稿日時 - 2012-01-22 18:06:58

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問