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
No.1ベストアンサー
- 回答日時:
以下のようにすればたぶんできると思います。
(検証してないので保証はできません…)
(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"))
この回答への補足
御回答ありがとうございます。早速試そうと思ったのですが、
RefreshBackgroundQuery:=Falseの部分が黄色になって停止するのです。
これは、マクロを書き換える前の状態でもおきました。
ネットで調べたのですが、InternetExplore7を導入したせい(そのため「セキュリティの警告 データ接続が無効にされました」という警告が出るようになりました)とあり、履歴を削除するなどしたのですが、マクロは作動しません。本質問とは別問題ですが、御教示いただければ幸いです。
No.4
- 回答日時:
#1です。
> RefreshBackgroundQuery:=Falseの部分が黄色になって停止するのです。
停止する前にポップアップ画面が出てエラーメッセージが
表示されると思うのですが、どんなメッセージが表示されますか?
> これは、マクロを書き換える前の状態でもおきました。
ということは、このマクロは一度も動いたことがないということですか?
それともIE7導入前には動作していたのですか?
IE7の導入が影響するのはWebクエリのようなので、
関係ないと思うのですが…
誤解を招いたようで、申し訳ありません。
もとはちゃんと作動していました(最後に使用したのは昨年8月)。
ところが、教えていただいたマクロが作動しなかったので、念のためもとのマクロを使ってみたら作動しなかっという経緯です。
しかし、教えていただいたように、まっさらなシートにマクロをコピペしたら動きました。
どうもありがとうございました。
No.3
- 回答日時:
ご質問で掲示されたマクロがそもそも動いてませんでしたって、いったいどういうことですか。
>本質問とは別問題です
全くその通りですね。ご自分でも判ってらっしゃるのですから、まずその点を別のご相談なり投稿してきちんとクリアしてから、このご質問に戻って「次のステップとして」解決されたらどうですか。
その際には
>…の部分が黄色になって停止するのです。
その時に表示されるエラーのダイアログに具体的になんて書かれているか
ご利用のエクセルのバージョンは幾つを使っているのか
きちんと情報提供してください。このご相談で補足されても対応しませんので悪しからず。
また念のため、新規のまっさらのシートを1枚挿入
既存のシートを「すべて」全部まとめて漏れなくシートを削除して
から、マクロを実行してみます。
もちろん言わずもがなですが、マクロが必要としている「出馬表集計」「結果集計」の2枚のシートは、これも既存のシートは一回捨てて、まっさらのシートをそれぞれ挿入して正しい名前に変えてから行います。
>セキュリティの警告 データ接続が無効にされました
ご利用のエクセルのバージョンが不明ですが、エクセルのオプションからセキュリティセンターで「セキュリティセンターの設定」を開始、外部コンテンツの欄ですべてのデータ接続を有効にします。
お怒りをかったようで、申し訳ありません。
もとはちゃんと作動していました(最後に使用したのは昨年8月)。
ところが、教えていただいたマクロが作動しなかったので、念のためもとのマクロを使ってみたら作動しなかっという経緯です。
しかし、教えていただいたように、まっさらなシートにマクロをコピペしたら動きました。
どうもありがとうございました。
No.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
この回答への補足
御回答ありがとうございます。早速試そうと思ったのですが、
RefreshBackgroundQuery:=Falseの部分が黄色になって停止するのです。
これは、マクロを書き換える前の状態でもおきました。
ネットで調べたのですが、InternetExplore7を導入したせい(そのため「セキュリティの警告 データ接続が無効にされました」という警告が出るようになりました)とあり、履歴を削除するなどしたのですが、マクロは作動しません。本質問とは別問題ですが、御教示いただければ幸いです。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Access(アクセス) エクセルのマクロについて教えてください。 2 2023/02/04 14:20
- Visual Basic(VBA) マクロを短くする 1 2023/01/15 00:11
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Visual Basic(VBA) エクセル VBA 処理スピードを上げたいのですが。 6 2023/03/31 20:52
- Excel(エクセル) エクセルのマクロでコピー後の貼り付け先を毎回指定したところにしたい 5 2022/08/12 10:47
- Visual Basic(VBA) excelVBAについて。 4 2022/11/21 16:15
- Excel(エクセル) エクセル VBAでシートのコピーを作りたい 1 2023/05/18 07:42
- Visual Basic(VBA) VBAでエクセルをtxtに変換するとエクセルでカンマを含む文字数字がtxtでは「""」付にならないよ 1 2022/08/27 12:17
- Excel(エクセル) ExcelVBAについて。 2 2022/12/10 20:08
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ピボットテーブルの項目間の計算
-
ピボットテーブルのことです
-
エクセルのピポットテーブルで...
-
エクセルで○や×の図形の集計は...
-
マクロで貼り付け位置を可変さ...
-
オートシェイプを色別に個数を...
-
ピボットテーブルで条件に合致...
-
勤務表の中抜け集計の関数を教...
-
Excel ピボットテーブルで日付...
-
エクセルで数値のプラス毎とマ...
-
エクセルの集計機能を横方向(...
-
保存ブックを開かずコピーペー...
-
excelでピボットテーブルと集計...
-
アクセスのFormat関数に...
-
エクセルのピボットテーブルで...
-
エクセルの集計を数字以外です...
-
ある審査の結果を迅速にエクセ...
-
アンケート結果の集計方法(エ...
-
ワードで配布したアンケートの集計
-
EXCELで大文字と小文字を...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ピボットテーブルのことです
-
エクセルのピポットテーブルで...
-
マクロで貼り付け位置を可変さ...
-
エクセルで○や×の図形の集計は...
-
ピボットテーブルの項目間の計算
-
エクセルの集計を数字以外です...
-
IF関数を使用した数字に、カン...
-
オートシェイプを色別に個数を...
-
パワーポイントで資料を作る時 ...
-
勤務表の中抜け集計の関数を教...
-
列を増やさずに、月だけの件数...
-
Microsoft Formsによるアンケー...
-
ピボットテーブルへの集計フィ...
-
エクセルの集計機能を横方向(...
-
Excel週ごとの集計を関数で
-
保存ブックを開かずコピーペー...
-
エクセルで数値のプラス毎とマ...
-
エクセルを使ってCSVデータを自...
-
ピボットを使ったシートに計算...
-
ピボットテーブル オリジナル...
おすすめ情報