![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
下記の(1)(2)のマクロを(3)のコマンドボタンで実行させています。
(1)(2)を使用せずに(3)のコマンドボタンにまとめて記載したいのですが上手く出来ません。
また、(1)の"A:\あ.CSV"部分ですが、使用PCによってドライブが異なる場合があるります。セルC2に入力したドライブ名を反映させることはできないでしょうか?
よろしくお願いします。
(1) Sub I()
Workbooks.Open Filename:="A:\あ.xls"
lngR = Range("B65536").End(xlUp).Row
Range("B2:B" & lngR).Select
Selection.Copy
Windows("か.xls").Activate
Range("B3").Select
ActiveSheet.Paste
lngR = Range("B65536").End(xlUp).Row
Range("B2:F" & lngR).Select
With Selection.Font
.Size = 8
End With
End Sub
(2) Sub II()
Windows("あ.xls").Activate
lngR = Range("E65536").End(xlUp).Row
Range("E2:E" & lngR).Select
Selection.Copy
Windows("か.xls").Activate
Range("G3").Select
ActiveSheet.Paste
lngR = Range("G65536").End(xlUp).Row
Range("G2:G" & lngR).Select
Selection.Style = "Comma [0]"
With Selection.Font
.Size = 9
End With
Windows("あ.xls").Activate
ActiveWindow.Close
End Sub
(3) Private Sub 取込_Click()
Application.ScreenUpdating = False
Protect UserInterfaceOnly:=True
Application.Run "I"
Application.Run "II"
Selection.Locked = False
Applicaion.ScreenUpdating = True
End Sub
A 回答 (3件)
- 最新から表示
- 回答順に表示
No.3
- 回答日時:
おはようございます
遅くなり申し訳ない所存です。
まずは訂正から
lngR = Range("B2").CurrentRegion.Row
の部分は
lngR = Range("B2").CurrentRegion.Rows.Count
です。重ねてお詫び申し上げます。
ご質問に関しては
Dim myドラ As String
Dim myブック As String
myドラ = ActiveSheet.Range("C2").Value
myブック = ActiveSheet.Range("E2").Value & ".csv"
Workbooks.Open Filename:=myドラ & ":\" & myブック
で良いかと思います。
No.2
- 回答日時:
少し編集してみました。
これで動くようでしたら、再度一まとめにしてみてください。
尚、Sub I、IIは Module1 にコピーで、Sub 取込_Clickと同じファイルに入れてください。Windows("あ.csv") はWorkbooks("あ.csv").Sheets(1) に変更しました。
Selectはなるべく使用しないようにしました。
最終行を求める方法は2通りにしてあります。
Dim lngR As Long '(3万行ないならIntegerのほうがいいです)
Dim myドラ As String
Sub I()
myドラ = ActiveSheet.Range("C2").Value
Workbooks.Open Filename:=myドラ & ":\" & "あ.xls"
lngR = Range("B2").CurrentRegion.Row
Range("B2:B" & lngR).Copy Destination:=Workbooks("か.xls").Sheets(1).Range("B3")
Workbooks("か.xls").Sheets(1).Activate
Range("B2:F" & lngR + 1).Font.Size = 8
End Sub
Sub II()
Workbooks("あ.csv").Sheets(1).Activate
lngR = Range("E65536").End(xlUp).Row
Range("E2:E" & lngR).Copy Destination:=Workbooks("か.xls").Sheets(1).Range("G3")
Workbooks("か.xls").Sheets(1).Activate
With Range("G2:G" & lngR + 1)
.Style = "Comma [0]"
.Font.Size = 9
End With
Workbooks("あ.csv").Activate
Workbooks("あ.csv").Close
End Sub
Sub 取込_Click()
Application.ScreenUpdating = False
'Protect UserInterfaceOnly:=True
Call Module1.I
Call Module1.II
'Selection.Locked = False
Application.ScreenUpdating = True
End Sub
この回答への補足
おはようございます。
回答No.2の方法を試してみました。
少ない知識と勘で、考えられる限り試行錯誤してみましたが、結果に別の問題が生じてしまいました。
根本的に、作成したBookの構成に起因するものと思われます。
きっと総合的にスマートな方法があるのでしょうが、ここに構成や記述の詳細を全て挙げる時間とスペースがないので、今回は基本的に元の状態で進めます。
いずれアクセスで処理すべきものなのでしょうが・・・
教えて頂いた方法は今後に生かしたいと思います。
ありがとうございました。
それから、この場をお借りしてもう一つ知りたい事があります。
myドラ=ActiveSheet.Range("C2").Value
Workbooks.Open Filename:=myドラ & ":\" & "あ.csv"
上記の"あ"の部分を"E2"から取得する方法はありますか?
こちらも試行錯誤していますが、未だ正解に辿りつけません。
よろしくお願いします。
No.1
- 回答日時:
おはようございます
まず、何がどのようにまくいかないのでしょう?
もう少しご説明なさらないと、回答にこまります。
>また、(1)の"A:\あ.CSV"部分ですが、使用PCによってドライブが異なる場合があるります
CSVがありません。
また、"A:\あ.CSV"のような、大胆なディレクトリの使い方はリムーバブルディスクということでしょうか?
そういうことといたしまして(細かなディレクトリがある場合はご自分で入れてください、C:\Documents and Settings\Owner\My Documentsとかです)
セルC2にたとえば A とかで入れるとして、
Workbooks.Open Filename:="A:\あ.xls"
を
myドラ=ActiveSheet.Range("C2").Value
Workbooks.Open Filename:=myドラ & ":\" & "あ.xls"
にすれば良いかと思います。
>Protect UserInterfaceOnly:=True
ActiveSheet.Protect UserInterfaceOnly:=True
でしょうか。
最後に、(3)におまとめになるのでしたら
Application.Run "I"、Application.Run "II"それぞれの部分を
Sub I、IIの中身をコピー&ペーストで置き換えれば良いかと思います。
この回答への補足
おはようございます。
早朝からの回答ありがとうございます。
>"A:\あ.CSV"のような、大胆なディレクトリの使い方はリムーバブルディスクということでしょうか?
その通りです。
ファイル指定の部分は教えていただいた記述で解決する事が出来ました。
ありがとうございます。
>CSVがありません。
すみません。
(1),(2)の"A:\あ.xls"部分は"A:\あ.CSV"の誤りでした。
(3)の"I","II"の部分をそのまま置き換える方法ですと、
最初のRange("B2:B" & lngR).Selectの部分でエラーになってしまいます。
Workbooksから指定しなおしてみたのですが上手くいきません。
このサイトから似たような例を検索して一部書き換えて使う程度の知識しかなく、自力で解決できませんでした。
現状でも機能はしているのですが疑問に思った次第です。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 動きっぱなしです。止め方とプロシージャの間違いを教えて下さい! 5 2022/08/15 23:08
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) vbaのエラー対応(実行時エラー7:メモリが不足しています) 4 2023/04/24 00:20
- Visual Basic(VBA) ExcelVBAのマクロについて。 9 2022/05/04 14:50
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Visual Basic(VBA) VBAが止まります。 1 2022/09/02 14:51
- Excel(エクセル) エクセル VBAでシートのコピーを作りたい 1 2023/05/18 07:42
- Excel(エクセル) 表示形式、文字列セル(列)に数式を入力するには マクロ 1 2022/09/18 10:53
- Excel(エクセル) vba userformで漢字を全角カタカナに 2 2022/07/24 15:38
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
フォルダ内の全ブックのシート...
-
【ExcelVBA】指定の書式で、マ...
-
すでに開いているブックのマク...
-
フォルダ内の全ブックのシート...
-
VB2010でExcelの行をコピーして...
-
エクセルVBA Workbook変数に変...
-
ExcelVBAで今開いているユーザ...
-
excelマクロ、任意セルの値で名...
-
excelでハイパーリンク 別ブッ...
-
別ブックからのデータ取り込み
-
VBA、Excelのworkbook.open に...
-
Excel マクロでファイル名を変...
-
Excelの一括印刷で通し番号をつ...
-
EXCELマクロでxlsとxlsxを開く方法
-
同じ名前で拡張子が違うファイル
-
フォルダ内の全てのBookに同じ...
-
VBA セル入力された日付データ...
-
EXCEL VBAアドイン:シートの右...
-
【Excel VBA】ブックを複数開い...
-
複数のデータ系列の線の太さを...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
フォルダ内の全ブックのシート...
-
ExcelVBAで今開いているユーザ...
-
エクセルVBA Workbook変数に変...
-
【Excel VBA】ブックを複数開い...
-
【ExcelVBA】指定の書式で、マ...
-
VB2010でExcelの行をコピーして...
-
フォルダ内の全ブックのシート...
-
EXCELマクロでxlsとxlsxを開く方法
-
他のBookのユーザー定義関数を使う
-
VBA、Excelのworkbook.open に...
-
すでに開いているブックのマク...
-
フォルダ内の全てのBookに同じ...
-
personal.xlsの削除方法
-
[Excel VBA] フォルダ内の複数...
-
excelマクロ、任意セルの値で名...
-
excelでハイパーリンク 別ブッ...
-
VBA セル入力された日付データ...
-
Excel マクロでファイル名を変...
-
EXCEL VBA起動時の処理
-
エクセルVBAでブックを開くと処...
おすすめ情報