EXCELマクロの処理時間を短縮したい
EXCELマクロの時間短縮で悩んでいます。どうかお知恵をお貸し下さい。（長文です）
Windows XP Pro
EXCEL 2002 を使用しています。
以下の作業の２．のところで２分以上 ３．のところで２分以上の時間が掛かっています
マクロソースによるこれ以上の短縮は望めないでしょうか？
＜作業内容＞
1. OLEDBを使って他のDBから
トランザクション「Ａ」のデータを シート「Ａ」に
マスタ「Ｍ」のデータを シート「Ｍ」に展開しています
2. シート「Ａ」のデータは 約４０，０００件 （変動します）
番号 基本番号＋枝番(1桁) 最初は基本番号＋0で変更があると枝番をカウントアップして追加
最新番号 変更が合った場合 変更の回数（枝番=0のレコードだけ更新)
コード 名称コード
数量
単価 小数点以下 ２桁まで
追加数量
追加単価
番号 ｜最新番号｜コード｜ 数量 ｜ 単価 ｜ 追加数量｜追加単価｜
1000010 ｜ 0 ｜123456｜ 1,000｜100.30｜ 10｜1,000.00｜
1000020 ｜ 2 ｜111111｜ 1,000｜200.50｜ 1｜5,000.00｜
1000021 ｜ 0 ｜111111｜ 900｜200.50｜ 2｜5,000.00｜
1000022 ｜ 0 ｜111111｜ 1,000｜200.00｜ 1｜5,000.00｜
1000030 ｜ 0 ｜123000｜ 2,500｜ 90.75｜ 0｜ 0.00｜
9500010 ｜ 0 ｜999999｜ 0｜ 0.00｜ 0｜ 0.00｜
これを シート「一覧」に基本番号別に枝番が最新の行をコピーして金額を出します
約 ３５，０００件になります
基本番号 ｜コード｜ 名称 ｜ 数量 ｜ 単価 ｜ 追加数量｜追加単価｜ 金額
100001 ｜123456｜ ｜ 1,000｜100.30｜ 10｜1,000.00｜110,300
100002 ｜111111｜ ｜ 1,000｜200.00｜ 1｜5,000.00｜205,000
100003 ｜123000｜ ｜ 2,500｜ 90.75｜ 0｜ 0.00｜226,875
3. シート「Ｍ」のデータは 約３０，０００件 （変動します）
コード ｜ 名称 ｜
111111｜ AAAAAAAAAA ｜
123000｜ ABCDEFGHIJ ｜
123456｜ BBBBBBBBBB ｜
シート「一覧」の名称に名称を入れます
基本番号 ｜コード｜ 名称 ｜ 数量 ｜ 単価 ｜ 追加数量｜追加単価｜ 金額
100001 ｜123456｜BBBBBBBBBB｜ 1,000｜100.30｜ 10｜1,000.00｜110,300
100002 ｜111111｜AAAAAAAAAA｜ 1,000｜200.00｜ 1｜5,000.00｜205,000
100003 ｜123000｜ABCDEFGHIJ｜ 2,500｜ 90.75｜ 0｜ 0.00｜226,875
＜マクロ ソース＞
Sub 一覧作成()
Dim i As Long, j As Long, k As Long, read_no As Long
Dim jlist As Worksheet, jdata As Worksheet
Dim v As Variant, w As Variant
Dim dic As Object
Application.ScreenUpdating = False '画面停止
'ＤＢ取り込み ※省略
Set jlist = Worksheets("一覧") '処理２
Set jdata = Worksheets("Ａ")
jlist.Cells.ClearContents
jlist.Range("A1").Value = "基本番号"
jlist.Range("B1").Value = "コード"
jlist.Range("C1").Value = "名称"
jlist.Range("D1").Value = "数量"
jlist.Range("E1").Value = "単価"
jlist.Range("F1").Value = "追加数量"
jlist.Range("G1").Value = "追加単価"
jlist.Range("H1").Value = "金額"
i = 2 '今読んでる行
k = 2 '書いている行
j = 0 '枝番が合った場合 飛ばす行
read_no = 0
Do While jdata.Cells(i, 1).Value < 9500000
read_no = jdata.Cells(i, 1).Value / 10
j = 0
If jdata.Cells(i, 2).Value <> 0 Then '枝番有
j = judata.Cells(i, 2)
End If
i = i + j
jlist.Cells(k, 1).Value = Format(read_no, "000000")
jlist.Cells(k, 2).Value = jdata.Cells(i, 3).Value
jlist.Cells(k, 4).Value = jdata.Cells(i, 4).Value
jlist.Cells(k, 5).Value = jdata.Cells(i, 5).Value
jlist.Cells(k, 6).Value = jdata.Cells(i, 6).Value
jlist.Cells(k, 7).Value = jdata.Cells(i, 7).Value
jlist.Cells(k, 8).Value = _
Application.RoundDown((jdata.Cells(i, 4).Value * jdata.Cells(i, 5).Value + _
jdata.Cells(i, 6).Value * jdata.Cells(i, 7).Value), 0)
k = k + 1
i = i + 1
Loop
Set jname = Worksheets("Ｍ") '処理３
With jname
With .Range("B2", .Cells(.Rows.Count, 1).End(xlUp))
v = .Columns(1).Value
w = .Columns(2).Value
End With
End With
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(v)
dic(v(i, 1)) = i
Next
With jlist
With .Range("B2", .Cells(Rows.Count, 4).End(xlUp)) 'B2～Dの最終行まで
v = .Value
For i = 1 To UBound(v)
If dic.exists(v(i, 1)) Then
v(i, 2) = w(dic(v(i, 1)), 1)
Else
v(i, 2) = "無"
End If
Next
With .Offset(0, 0)
.ClearContents
.Value = v
End With
End With
End With
Set dic = Nothing
Set jlist = Nothing
Set jname = Nothing
Application.ScreenUpdating = True
End Sub
お礼
writer.write("Connection: Close\r\n"); これを23, 24行の間に追加するとすぐに"end"を出力することができました。 HTTP 1.1などは気にしておらず自分では解決できそうにありませんでした。 ありがとうございました。