データベース更新時間を短くしたい

質問

環境
EXCEL2003-Oracle Database 11g Release 2 Client(11.2.0.1.0) for Microsoft Windows(32-bit)

excelマクロでデータベース更新時間を短くする方法を教えていただきたく。

オラクルのデータベースに作業時間の実績が登録されるＡシステムがあります。
このＡシステムはＢシステムと連携しています。
Ｂシステムのチームコード変更は10/6までに対応される予定で、
それと連携してＡシステム側もチームコード変更が必要になります。
Ａシステム側の変更は、いろんなテーブルにチームコードが関連しているので、
暫定対策として、ＡからＢにデータを渡すテーブルのみチームコードを変更しようとしています。

OSQLというツールで実績のチームコードを変更してもよいのですが、
編集で開いてしまうと、実績収集が停止してしまう為、実績を変更するexcelマクロを作成しました。
ところが、実際に動かしてみると、とても長い時間がかかってしまいます。（10分程度）

下記がマクロです。
マクロはいろんなサイトから寄せ集めたもので、私はマクロに関しては全くの初心者です。
なので、実際のコードでどこをどの様に変更したらよいかを教えていただきたく。

Private Sub man_Click()

'MANテーブルから登録されている実績をダウンロードする

Sheets("man_koshin").Select
Call ClearmanDisp

'oo4o用のオブジェクト変数の宣言
Dim OraSession As Object 'セッション
Dim OraDatabase As Object 'データベース
Dim rs As Object 'データセット(レコードセット)
Dim rownum As Long
Dim colnum As Integer

Dim ID As String
Dim ED As Long
Dim SQL_STR As String

Application.ScreenUpdating = False
'sheet2のA1セルを参照し、接続先を切り替える

ID = Sheets("sheet2").Range("A1")

'セッションオブジェクトの生成
Set OraSession = CreateObject("OracleInProcServer.XOraSession")
'接続環境
'oo4oデータベースオブジェクトの生成（DBへUserID:im、パスワード:intで接続）
Set OraDatabase = OraSession.OpenDatabase(ID, "im/int", 0&)

'MANテーブルから2013.10以降の実績を取得する
Set rs = OraDatabase.CreateDynaset("select * from MAN where DATE > '201310'", 0&)

'フィールド名の表示
For colnum = 0 To rs.Fields.Count - 1
ActiveSheet.Cells(1, colnum + 2) = rs(colnum).Name
Next

'データの表示
rownum = 0
Do Until rs.EOF
For colnum = 0 To rs.Fields.Count - 1
ActiveSheet.Cells(rownum + 2, colnum + 2) = rs(colnum).Value
Next
rs.MoveNext
rownum = rownum + 1
Loop

'オブジェクトのクローズ
rs.Close

'各種オブジェクトの開放
Set rs = Nothing
Set OraDatabase = Nothing
Set OraSession = Nothing

'チームコードをAからBに変更。チーム名称の置換処理

Cells.Replace What:="A", Replacement:="B", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

'変更したチーム名称でMANテーブルを更新

On Error GoTo ERR_HANDLER
'oo4o用のオブジェクト変数の宣言
Dim OraSession As Object 'セッション
Dim OraDatabase As Object 'データベース
Dim rs As Object 'データセット(レコードセット)
Dim rownum As Long
Dim colnum As Integer

Dim ID As String
Dim SQL_STR As String

ID = Sheets("sheet2").Range("A1")

'oo4oセッションオブジェクトの生成
Set OraSession = CreateObject("OracleInProcServer.XOraSession")
'oo4oデータベースオブジェクトの生成（DBへUserID:ID、パスワード:intで接続）
Set OraDatabase = OraSession.OpenDatabase(ID, "im/int", 0&)
'oo4oデータセット(レコードセット)の生成（全データを返すレコードセットの生成）
Set rs = OraDatabase.CreateDynaset("select * from MAN", 0&)

'データの更新
For rownum = 2 To 20000
If ActiveSheet.Cells(rownum, 5) = "" Then
Exit For
End If
'更新対象データの検索
rs.Findfirst ("TIME=" & ActiveSheet.Cells(rownum, 5))
'編集モードに設定
rs.Edit
For colnum = 1 To rs.Fields.Count - 1
Select Case rs(colnum).Type
Case 10
rs(colnum).Value = ActiveSheet.Cells(rownum, colnum + 2)
Case 8
rs(colnum).Value = CDate(ActiveSheet.Cells(rownum, colnum + 2))
Case Else
rs(colnum).Value = ActiveSheet.Cells(rownum, colnum + 2)
End Select
Next
rs.update
Next
'オブジェクトのクローズ
rs.Close

QUIT_OPER:
'オブジェクト変数用に確保したメモリの開放
Set rs = Nothing
Set OraDatabase = Nothing
Set OraSession = Nothing
Exit Sub

End Sub

データの更新を20000件分としているのでこれが遅くなっている要因です。
１日700件くらい実績があがるので１ケ月で実働20000件あれば十分かと考えました。
チームコード変更は、まとめて月末に実施しようと思っていますが、
時間がかかるのであれば、週(20000件→5000件程度）あるいは日(20000件→800件程度)単位でやるしかないかと思っています。

回答No.1

matyu1003 · ベストアンサー

同様のシステムがあるわけではありませんし、データの詳細が分からない（もちろん、さらすわけにもいかないでしょうが）ので何とも言えませんが、あからさまに無駄な操作をしているようには見えませんね。
なので、クライアントマシンのスペックを上げる、クライアントマシンを複数台用意しデータを分割して並列処理、サーバマシンのスペックを上げる、ぐらいしか思い浮かびません。

お礼

回答ありがとうございました。
当面チームコードは従来のまま使用することとなりました。
チームコード変更が必要な場合は、分割して対応しようと思います。