みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

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

解決済みの質問

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

投稿日時 - 2012-05-22 21:10:42

QNo.7490450

暇なときに回答ください

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

以下のようにすればたぶんできると思います。
(検証してないので保証はできません…)

(1)ソース全体を以下のA・Bの文で挟んでください。
A↓
Dim i as long
For i = 1 to 99 step 2
B↓
next i

(2)次の文を以下のように置き換えてください。
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\2.", Destination:=Range("A1"))
 ↓
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\" & i+1 & ".", Destination:=Range("A1"))

(3)次の文を以下のように置き換えてください。
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\1.", Destination:=Range("A1"))

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\" & i & ".", Destination:=Range("A1"))

投稿日時 - 2012-05-22 21:31:56

補足

御回答ありがとうございます。早速試そうと思ったのですが、
RefreshBackgroundQuery:=Falseの部分が黄色になって停止するのです。
これは、マクロを書き換える前の状態でもおきました。
ネットで調べたのですが、InternetExplore7を導入したせい(そのため「セキュリティの警告 データ接続が無効にされました」という警告が出るようになりました)とあり、履歴を削除するなどしたのですが、マクロは作動しません。本質問とは別問題ですが、御教示いただければ幸いです。

投稿日時 - 2012-05-24 18:31:56

ANo.1

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

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

回答(4)

ANo.4

#1です。

> RefreshBackgroundQuery:=Falseの部分が黄色になって停止するのです。

停止する前にポップアップ画面が出てエラーメッセージが
表示されると思うのですが、どんなメッセージが表示されますか?


> これは、マクロを書き換える前の状態でもおきました。

ということは、このマクロは一度も動いたことがないということですか?
それともIE7導入前には動作していたのですか?

IE7の導入が影響するのはWebクエリのようなので、
関係ないと思うのですが…

投稿日時 - 2012-05-24 19:41:04

お礼

 誤解を招いたようで、申し訳ありません。
 もとはちゃんと作動していました(最後に使用したのは昨年8月)。
 ところが、教えていただいたマクロが作動しなかったので、念のためもとのマクロを使ってみたら作動しなかっという経緯です。
 しかし、教えていただいたように、まっさらなシートにマクロをコピペしたら動きました。
 どうもありがとうございました。
 

投稿日時 - 2012-05-24 22:07:46

ANo.3

ご質問で掲示されたマクロがそもそも動いてませんでしたって、いったいどういうことですか。

>本質問とは別問題です

全くその通りですね。ご自分でも判ってらっしゃるのですから、まずその点を別のご相談なり投稿してきちんとクリアしてから、このご質問に戻って「次のステップとして」解決されたらどうですか。



その際には
>…の部分が黄色になって停止するのです。

その時に表示されるエラーのダイアログに具体的になんて書かれているか
ご利用のエクセルのバージョンは幾つを使っているのか
きちんと情報提供してください。このご相談で補足されても対応しませんので悪しからず。



また念のため、新規のまっさらのシートを1枚挿入
既存のシートを「すべて」全部まとめて漏れなくシートを削除して
から、マクロを実行してみます。

もちろん言わずもがなですが、マクロが必要としている「出馬表集計」「結果集計」の2枚のシートは、これも既存のシートは一回捨てて、まっさらのシートをそれぞれ挿入して正しい名前に変えてから行います。



>セキュリティの警告 データ接続が無効にされました

ご利用のエクセルのバージョンが不明ですが、エクセルのオプションからセキュリティセンターで「セキュリティセンターの設定」を開始、外部コンテンツの欄ですべてのデータ接続を有効にします。

投稿日時 - 2012-05-24 19:40:45

お礼

 お怒りをかったようで、申し訳ありません。
 もとはちゃんと作動していました(最後に使用したのは昨年8月)。
 ところが、教えていただいたマクロが作動しなかったので、念のためもとのマクロを使ってみたら作動しなかっという経緯です。
 しかし、教えていただいたように、まっさらなシートにマクロをコピペしたら動きました。
 どうもありがとうございました。
 

投稿日時 - 2012-05-24 22:06:04

ANo.2

dim i

ActiveWorkbook.Worksheets.Add
activesheet.name = "temp"

for i = 2 to 100 step 2
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\" & i & ".", Destination:=Range("A65536").end(xlup).offset(1))
.Name = i & "."
.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
next i


'Sheets("出馬表集計")に貼り付け
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("出馬表集計").Select
Range("A1").Select
ActiveSheet.Paste

range("1:1").delete shift:=xlshiftup
application.displayalerts = false
worksheets("Temp").delete
application.displayalerts = true

'BetMasterから結果データの取り込み

ActiveWorkbook.Worksheets.Add
activesheet.name = "Temp"

for i = 1 to 99 step 2
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\" & i & ".", Destination:=Range("A65536").end(xlup).offset(1))
.Name = i & "."
.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
next i

'Sheets("結果集計")に貼り付け
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("結果集計").Select
  Range("A1").Select
ActiveSheet.Paste

range("1:1").delete shift:=xlshiftup
application.displayalerts = false
worksheets("Temp").delete
application.displayalerts = true

投稿日時 - 2012-05-22 21:39:20

補足

御回答ありがとうございます。早速試そうと思ったのですが、
RefreshBackgroundQuery:=Falseの部分が黄色になって停止するのです。
これは、マクロを書き換える前の状態でもおきました。
ネットで調べたのですが、InternetExplore7を導入したせい(そのため「セキュリティの警告 データ接続が無効にされました」という警告が出るようになりました)とあり、履歴を削除するなどしたのですが、マクロは作動しません。本質問とは別問題ですが、御教示いただければ幸いです。

投稿日時 - 2012-05-24 18:32:38

あなたにオススメの質問