エクセル・マクロ CSVファイルの読込方法と改行

質問

マクロがうまく作成出来ずにいます。
是非、教えて頂けないでしょうか、宜しくお願い致します。

マクロでやりたい事は二つあります。
（1）あるシステムよりRドライブ内にデータを落とし、その後エクセルシートへ貼り付ける作業を行っているのですが、この作業をマクロで出来るようにしたいです。
ただ、データを落とした段階では拡張子表示にしても何もついていないデータになっていますが、中身からしておそらくCSV形式のデータだと思います。

（2）シート(1)、(2)、(3)にあるデータをシート(4)に順番に貼り付けていきたいのですが、(1)のシートのデータと(2)の間に空白の行を一行、(2)と(3)の間にも空白の行を一行としていきたいのです。

（2）に関しては途中までマクロを書いたのですが、エラーが出てうまくいきません。
作成したマクロは以下です。

Sheets("summary").Activate

Range("A3").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents

'AUD シート

Sheets("AUD").Activate
ActiveSheet.Range("A1").Select
ActiveSheet.Range("A1:P1").Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("summary").Activate

ActiveSheet.Range("A3").Select
ActiveSheet.Paste

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

Application.CutCopyMode = False
ActiveCell.Select

ActiveSheet.Range(Selection.End(xlDown)).Select

Cells.Replace What:=Chr(10), Replacement:="<br>"

最後の数行でエラーが出ます。

マクロの初心者でこんな事もわからないのかと思われるかもしれませんが、
どうぞ宜しくお願い致します。

回答No.6

hallo-2007 · ベストアンサー

Sheets("Sheet1").Range("1:100").Copy
Sheet1の１行目から１００行目ですが　データが多ければ
１０００でも１００００でもOKです。ただたっぷり範囲を指定してだけです。
Range("A65536").End(xlUp).Offset(2, 0).PasteSpecial
A列の最後の行(65536)から上へ移動して空白でない行
2行(2, 0)上へ移動して貼り付け
動きだけ確認してください。使える部分を使ってください。

お礼

教えていただいたマクロ(2)を応用してマクロが完成いたしました。
本当にありがとうございます。とても助かりました。

(1)の方なのですが、記録を利用してやってみたのですが、

ChDir "R:\"
Workbooks.OpenText Filename:="R:\", Origin:=932, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=
False, Tab:=True, Semicolonfiltered=True, Comma:=False, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10 _
, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
Array(17, 1)), TrailingMinusNumbers:=True
Cells.Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientationfiltered=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
ActiveWindow.SmallScroll Down:=120
Rows("134:190").Select
Selection.ClearContents
Cells.Select
Range("A114").Activate

とまだまだ続くのですがCells.Selectの行でエラーがでてしまいます。

これは何故でしょうか？
考えうる他のものに変換してやってみたのですがうまくいきません。
もしおわかりでしたら教えていただけないでしょうか。。。

これは別として(2)が出来た事やご回答いただいた事等本当にありがとうございます。

回答No.8

n-jun

>しかし、このマクロを走らせると、シートは開くのですがCSV形式のまま開いてしまいます
>（マクロの記録時にはきちんとエクセル形式で表示していたのですが・・・）
データはＣＳＶ形式なんですよね？（拡張子はないとの事ですが）

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_020.html
それとも上記のようにExcelシートに取り込みたいと言う事でしょうか？

お礼

はい。
データの取り込み、出来るようになりました。いろいろご迷惑をおかけしてすみませんでした。
皆様のおかげでちょっとずつマクロが（簡単なものですが。。）出来るようになってきました。ありがとうございます。

でも、他の事でまた躓いてしまい、類似案件を探してみたのですが見つかりませんでしたので、またそれに関しては別の質問をしておりますので、もしまたご教示いただける点があれば助かります。

本当にありがとうございました！

回答No.7

n-jun

>Cells.Selectの行でエラーがでてしまいます。
これは、Workbooks.OpenText後ですか？
それとも、Selection.ClearContents後ですか？
実際にエラーが出た箇所がどこなのか提示願います。

お礼

おはようございます。

このマクロを今朝、もう一度走らせたのですが、最初の一行目からエラーが出てしまいました。
昨日は下から三行目でエラーが出たのですが。

そこで、再度マクロの記録を使用したのですが、出来上がったのが下記のマクロです。

Sub Macro4()
'
' Macro4 Macro
' Macro recorded 2008/7/28 by Shinsei　User
'

'
ChDir "R:\CMPC\Treasury P&L\P&L\Treas_Trade_to_mark"
Workbooks.OpenText Filename:= _
"R:\CMPC\Treasury P&L\P&L\Treas_Trade_to_mark\trade to mark", Origin:=932, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10 _
, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
Array(17, 1)), TrailingMinusNumbers:=True
End Sub

しかし、このマクロを走らせると、シートは開くのですがCSV形式のまま開いてしまいます。（マクロの記録時にはきちんとエクセル形式で表示していたのですが・・・）

何度もすみません。
どうぞ宜しくお願い致します。

回答No.5

imogasi

#3です。
回答のデータ例でまずやってみること。
やっていることを理解し、その後自分のケースに類推して、修正しやってみること。
やっても居ないで、あれこれ言ってませんか。やってから追加質問してください。
他の質問・回答で、「ありがとうございます、後でやって見ます」なんてお礼も沢山あるが、回答者は長年の経験により、折角時間をかけて回答しているのだから、試行ぐらいして、お礼を書いてほしい。
質問者と違う観点からやっている場合もあり、質問者の考えの延長でどうのこうの言う前に、まづやってみてください。

お礼

すみません、昨日にお礼をアップしたつもりなのですが、仕事中に急いで書き込んでいたせいかアップされていませんでした・・・

ご指摘ありがとうございます。ご指摘はおっしゃる通りです。申し訳ございません。

ただ、言い訳に聞こえてしまうかもしれませんが、仕事を何個も抱えていて締め切りにおわれている中で、今回のマクロはそれらを自分の仕事を効率的にこなせるようにと私的に作成している物なので、勤務時間外や仕事の合間をぬって作成しているものなので、皆様に教えていただいてすぐにとりかかり結果を踏まえたうえで返答したいのですがそれが出来きませんでした。私の中では、善意で回答していただいているコメントをそのままコメントもなくおいておくのは失礼だしよくないと思い試す前にまずお礼をとお礼のコメントをと書き込みました。その時に質問を載せてしまったのです。。。今思えばそれがダメだったのですね。あくまでもお礼のみにすべきだったのかもしれません。

理由はなんであれ、不快感を与えました事、また他の方にも試さずに質問したこと、申し訳ございませんでした。

回答No.4

n-jun

ANO.1です。

取り敢えず（２）について。
貼り付けて罫線を引く所までのサンプル。

Sub　test()
　Dim　ws1　As　Worksheet
　Dim　ws2　As　Worksheet
　Dim　r1　As　Range,　r2　As　Range

　Set　ws1　=　Worksheets("summary")
　Set　r1　=　ws1.Range("A3")

　ws1.Cells.ClearContents
　For　Each　ws2　In　Worksheets
　　　　　If　ws2.Name　<>　ws1.Name　Then
　　　　　　　　With　ws2
　　　　　　　　　　　　　Set　r2　=　.Range("A1",　.Cells(Rows.Count,　1)　_
　　　　　　　　　　　　　　　　　　　　　　.End(xlUp).Resize(,　16))
　　　　　　　　End　With
　　　　　　　　r2.Copy　r1
　　　　　　　　With　r1.Resize(r2.Rows.Count,　16)
　　　　　　　　　　　　　With　.Borders(xlEdgeLeft)
　　　　　　　　　　　　　　　　　　.LineStyle　=　xlContinuous
　　　　　　　　　　　　　　　　　　.Weight　=　xlMedium
　　　　　　　　　　　　　End　With
　　　　　　　　　　　　　With　.Borders(xlEdgeTop)
　　　　　　　　　　　　　　　　　　.LineStyle　=　xlContinuous
　　　　　　　　　　　　　　　　　　.Weight　=　xlMedium
　　　　　　　　　　　　　End　With
　　　　　　　　　　　　　With　.Borders(xlEdgeBottom)
　　　　　　　　　　　　　　　　　　.LineStyle　=　xlContinuous
　　　　　　　　　　　　　　　　　　.Weight　=　xlMedium
　　　　　　　　　　　　　End　With
　　　　　　　　　　　　　With　.Borders(xlEdgeRight)
　　　　　　　　　　　　　　　　　　.LineStyle　=　xlContinuous
　　　　　　　　　　　　　　　　　　.Weight　=　xlMedium
　　　　　　　　　　　　　End　With
　　　　　　　　End　With
　　　　　　　　Set　r1　=　r1.Offset(r2.Rows.Count　+　1)
　　　　　End　If
　Next
End　Sub

（１）については、どこからどこまでをマクロにしたいのか、
よく分かりませんでした。
（出力されたＣＳＶファイルを手作業でソート？してから、
　各々のシートに振り分けるようですが、基のデータの構成が
　今一つわからなかった。）

お礼

ご教示いただきありがとうございます。
取り急ぎ、お礼申し上げます。

教えていただいたマクロ、本日中に試します。
仕事の合間に時間を見つけてやっていきますので、すぐにご報告出来ないかもしれませんが、必ず報告とお礼、させていただきますので。

（1）に関してはRドライブに落とすまでは手作業で行いますので、エクセルシートにそのCSVファイルをエクセル形式で貼り付ける所までのマクロがうまく出来ません。
マクロの記録も昨夜試みましたが出来ませんでした。
その後のソート等のマクロは自分で作成完了しております。

重複いたしますが、本当にありがとうございます。

回答No.3

imogasi

（１）はマクロの記録の修正で出来るのでは。
データー外部データの取り込みー・・の操作記録で。
ーー
（２）について
下記のように、コード行数を少なく出来る。
質問者のコードのデバッグとは別に、VBAの経験を考えてください。
ーー
A-D列にデータがあると仮定。
集約はSheet4にするとする。
集約しないシートはSheet4以外混じってないものとする。
＞空白の行を一行あけています。
ーー
Sub test02()
Dim sh As Worksheet
For Each sh In Worksheets
If sh.Name <> "Sheet4" Then '集約シート
d = sh.Range("A65536").End(xlUp).Row
d1 = Worksheets("Sheet4").Range("A65536").End(xlUp).Row
sh.Range("A2:D" & d).Copy Worksheets("Sheet4").Range("a" & d1 + 2)
End If
Next
End Sub

お礼

ありがとうございます。

（1）はこれから試してみます。

（2）なのですが、
詳細は別の方の回答の所に記載しましたが
教えていただいたこれを利用すると
Application.CutCopyMode = Falseの後に挿入する形になりますか？

ただ、各々のシートにあるデータが何行にわたっているのかは毎回違うので
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
という行ははずせないのかなと思ったのですが、これでも大丈夫でしょうか？

皆さんに色々質問をしてしまい、すみません。。。

宜しくお願い致します。

補足

完成できるまでに時間がかかりお礼が送れてしまい申し訳ございません。

教えていただいたマクロに他の方のマクロも組み合わせて、(2)のシートのマクロが完成いたしました。
本当にありがとうございました。

(1)に関しまして、まだ躓いておりますので、もし可能でしたらまたご教示いただければ嬉しいです。
(エラー箇所は他の方の回答欄に記載）

本当にありがとうございます。

回答No.2

hallo-2007

一応参考としてですが
（１）　外部データの取り込みは　試されましたか
「データ」「外部データの取り込み」
一度設定しておくと次からは　「データの更新」が可能です。
外部データの「データ範囲プロパティ」では
ファイルを開いたときにに更新とか　色々設定が出来ます。

（２）
Sub Test1()
Sheets("Sheet1").Range("1:100").Copy
Range("A65536").End(xlUp).Offset(2, 0).PasteSpecial
End Sub
の動きはご希望に近くありませんか。

お礼

ご連絡ありがとうございます。
（1）に関しては、ご指摘通り
「データ」「外部データの取り込み」としてみましたが、さらに3つに分かれているのですがどれになるのでしょうか・・・
これで設定をすれば毎回csvでRドライブに落ちてくるのですか？だとするとそれとは別に、CSVをエクセルファイルに読み込むVBAも知りたいのですが。。。

（2）に関しては
このマクロはどこに挿入すればいいのでしょうか？Range("A65536")やRange("1:100")の数字はそのまま使用していいのですか？

質問ばかりで申し訳ありません。
お手数をお掛けしますが、ご教示いただければ幸いです。

宜しくお願い致します。

補足

教えていただいたマクロ(2)を応用してマクロが完成いたしました。
本当にありがとうございます。とても助かりました。

(1)の方なのですが、記録を利用してやってみたのですが、

ChDir "R:\"
Workbooks.OpenText Filename:="R:\", Origin:=932, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=
False, Tab:=True, Semicolonfiltered=True, Comma:=False, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10 _
, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
Array(17, 1)), TrailingMinusNumbers:=True
Cells.Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientationfiltered=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
ActiveWindow.SmallScroll Down:=120
Rows("134:190").Select
Selection.ClearContents
Cells.Select
Range("A114").Activate

とまだまだ続くのですがCells.Selectの行でエラーがでてしまいます。

これは何故でしょうか？
考えうる他のものに変換してやってみたのですがうまくいきません。
もしおわかりでしたら教えていただけないでしょうか。。。

これは別として(1)が出来た事やご回答いただいた事等本当にありがとうございます。

回答No.1

n-jun

直接の回答ではないですが、
>（1）あるシステムよりRドライブ内にデータを落とし、その後エクセルシートへ貼り付ける作業を行っているのですが、この作業をマクロで出来るようにしたいです。
>ただ、データを落とした段階では拡張子表示にしても何もついていないデータになっていますが、中身からしておそらくCSV形式のデータだと思います。
>（2）シート(1)、(2)、(3)にあるデータをシート(4)に順番に貼り付けていきたいのですが、(1)のシートのデータと(2)の間に空白の行を一行、(2)と(3)の間にも空白の行を一行としていきたいのです。
質問の()とシート名[？]の()は関連があるのでしょうか？

>最後の数行でエラーが出ます。
具体的な行とエラー内容の提示が必要かと。

お礼

ご連絡ありがとうございます。

わかりずらくてすみません。

詳しく説明すると、
まずAというシステムからAUDやEURやUSDといった様々が一緒になっているデータ（CSV形式）をRドライブに落とします。
その後、sort等で都合のいいように分けます。

一方で、貼り付けたいエクセルはsummry・AUD・EUR・USD・・・・と何枚かのシートから構成されています。

そこで、sortで分類わけしたものを各々対比するシート（AUDであればAUDページに）貼り付けていきます。

その後、各々のページ上でも加工を施し、それを最終的にsummryのシートに貼り付けていきます。

この際に（2）で言った一行空白行を挟んで各々のページのデータを張っていきたいのです。

エラーが出るのは
ActiveSheet.Range(Selection.End(xlDown)).Select
の行です。

宜しくお願い致します。