Excelマクロ 繰り返し?の設定方法を教えて下さ
BetMasterという競馬ソフトに記述されている
「TXT\2」のデータを抽出し、Sheets("出馬表集計")に貼り付け、
「TXT\1」のデータを抽出し、Sheets("結果集計")に貼り付ける
以下のようなマクロを組んでいます。1日終わるごとにTXT\2とTXT\1を作成してこの集計をしていたのですが、約1年間サボってしまい100回近く、このマクロを作動させなければならなくなりました。
そこで、TXT\1~100まで作成して、TXT\2とTXT\1の貼り付けが終わったら、「TXT\4とTXT\3」、「TXT\6とTXT\5」、「TXT\8とTXT\7」...............と「TXT\100とTXT\99」まで繰り返し抽出と貼り付けを行うようにしたいのですがどうしたらよいでしょうか。
問題は、50回繰り返すことと、2回目以降は前回終了の次の行に貼り付けるという点です。
よろしくお願い致します。
'BetMasterから出馬表データの取り込み
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\2.", Destination:=Range("A1"))
.Name = "1."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
'Sheets("出馬表集計")に貼り付け
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("出馬表集計").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
'BetMasterから結果データの取り込み
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\1.", Destination:=Range("A1"))
.Name = "1."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
'Sheets("結果集計")に貼り付け
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("結果集計").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
お礼
ありがとうございました。 以降、更新不具合の発生件数を日々調査していましたところ、あれから一度も問題は発生していません。再発生時に、ご教授頂いた方法を試したいと思います。本当にありがとうございました。返信が遅れましたことをお詫びします。