エクセルマクロの質問です。

質問

例えば、A.xlsというファイルに01.csv，02.csv，・・・，20.csvといういくつかのファイルからデータを取り出すのですが、A.xlsのシート１の1列目に01.csvの1列目を貼り付けて、01.csvの2列目はA.xlsのシート２の1列目に貼り付けるようにシートをずらして行って、02.csvの1列目はA.xlsのシート１の2列目、02.csvの2列目はA.xlsのシート２の2列目というようにしたいのですが、どのようなプログラムがよいのでしょうか？
エクセルマクロ初心者なので説明が不十分かも知れませんがよろしくお願いします。

回答No.5

peachstrea

勘違いしてましたでごじゃりますぅorz
（こんなことで受験大丈夫か？＞アタシ＜問題文良く読めといういい教訓になったかも？）

csvファイル名（拡張子を除いたファイル名）の数字が各シートでの列順になって、csvファイルのフィールド順がシートの順番になればいいんですね(^^ゞ

使い方は前回と同じでcsvファイルは01.csvから始まり02.csv、03.csv・・・98.csv、99.csvと連番であることとドラッグ＆ドロップで処理開始です。
処理速度はお世辞にも速くはないので、ScreenUpdatingをFalse→Trueにすれば少しは早くなるかもしれませんがパラパラ見えるのもそれはそれでなんだか面白いです（教科書の隅っこに書いたパラパラマンガみたい）。

'----Sample2.vbs----
Set objArgs = WScript.Arguments
Set objAXLS = CreateObject("Excel.Application")
objAXLS.Visible = True
Set Book = objAXLS.WorkBooks.Add
Set objFS = CreateObject("Scripting.FileSystemObject")
For i = 0 To objArgs.length - 1
m = 1
Set f = objFS.OpenTextFile(Replace(objArgs(i), objFS.GetBaseName(objArgs(i)), AddZero(i+1)), 1)
arrLine = Split(f.ReadAll, vbCrLf)
For j = 0 To UBound(arrLine)
arrCell = Split(arrLine(j), ",")
n = (UBound(arrCell)+1) - Book.Sheets.Count
If n > 0 Then
For p = 1 To n
Book.Sheets.Add
Next
End If
For k = 0 To UBound(arrCell)
With objAXLS
.Sheets("Sheet" & CStr(k+1)).Select
.Cells(m, i+1).Value = arrCell(k)
End With
Next
m = m + 1
Next
Next

Function AddZero(strNum)
If Len(strNum) = 1 Then
AddZero = "0" & strNum
Else
AddZero = strNum
End If
End Function
'----Code End----

PS:ここってタブはスペースに変換してくれないのね＞ねぇどうして？＞教えて！goo（爆）

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.4

DOUGLAS_

[回答番号：No.1] の DOUGLAS_ です。

　列ごとの読み込みでしたね。
　[回答番号：No.1] は、行ごとの読み込みのヒントでした。失礼いたしました。　　<(_ _)>

　ＶＢＡのコード丸出しになりますが、ついでに、行ごとの読み込みの場合もお示ししておきます。
MyPath = "D:\hoge\"
のところで、ＣＳＶファイル の保存されたフォルダのフルパス（最後に「\」マーク）を指定してください。

Sub 列ごとの読み込み()
　Application.ScreenUpdating = False
　　Dim MyPath As String
　　Dim MyFile As String
　　Dim i As Integer
　　Dim LastCol As Integer
　　Dim intCols As Integer
　　ActiveSheet.Name = "ファイル名"
　　MyPath = "D:\hoge\"
　　ChDir MyPath
　　MyFile = Dir(MyPath & "*.CSV")
　　Do While MyFile <> ""
　　　Sheets("ファイル名").Select
　　　LastCol = Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Column
　　　Cells(1, LastCol).Value = Replace(MyFile, ".CSV", "")
　　　Workbooks.Open MyPath & MyFile
　　　intCols = ActiveCell.SpecialCells(xlLastCell).Column
　　　ThisWorkbook.Activate
　　　For i = 1 To intCols
　　　　On Error Resume Next
　　　　　Sheets("" & i).Select
　　　　　If Err.Number <> 0 Then
　　　　　Sheets.Add after:=ActiveSheet, Type:="ワークシート"
　　　　　ActiveSheet.Name = i
　　　　　End If
　　　　On Error GoTo 0
　　　　Workbooks(MyFile).Sheets(Replace(MyFile, ".CSV", "")).Columns(i).Copy _
　　　　ThisWorkbook.Sheets("" & i).Columns(LastCol - 1)
　　　Next
　　　Workbooks(MyFile).Close
　　　MyFile = Dir
　　Loop
　　Sheets("ファイル名").Select
　　Range("A1").Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

Sub 行ごとの読み込み()
　Application.ScreenUpdating = False
　　Dim MyPath As String
　　Dim MyFile As String
　　Dim EndLineRow As Integer
　　Dim TextLine As Variant
　　Dim i As Integer
　　ActiveSheet.Name = "ファイル名"
　　MyPath = "D:\hoge\"
　　MyFile = Dir(MyPath & "*.CSV")
　　Do While MyFile <> ""
　　　Sheets("ファイル名").Select
　　　EndLineRow = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
　　　Cells(EndLineRow, 1).Value = Replace(MyFile, ".CSV", "")
　　　Open MyPath & MyFile For Input As #1
　　　Do While Not EOF(1)
　　　　Line Input #1, TextLine
　　　　On Error Resume Next
　　　　　i = i + 1
　　　　　Sheets("" & i).Select
　　　　　If Err.Number <> 0 Then
　　　　　　Sheets.Add after:=ActiveSheet, Type:="ワークシート"
　　　　　　ActiveSheet.Name = i
　　　　　End If
　　　　On Error GoTo 0
　　　　TextLine = Split(TextLine, ",")
　　　　Cells(EndLineRow - 1, 1).Resize(, UBound(TextLine) + 1).Value = TextLine
　　　Loop
　　　Close #1
　　　i = 0
　　　MyFile = Dir
　　Loop
　　Sheets("ファイル名").Select
　　Range("A1").Delete Shift:=xlUp
　Application.ScreenUpdating = True
End Sub

回答No.3

peachstrea

純粋なExcelマクロではないですが、VBSを経由した間接的Excelマクロというのはどうでしょう？

01.csvが次のような内容だとしますね。
1,2,3,4
A-1,B-1,C-1,D-1
A-2,B-2,C-2,D-2
A-3,B-3,C-3,D-3
A-4,B-4,C-4,D-4
A-5,B-5,C-5,D-5
A-6,B-6,C-6,D-6
A-7,B-7,C-7,D-7
A-8,B-8,C-8,D-8
A-9,B-9,C-9,D-9

便宜的に02.csvと03.csvと04.csvというのもあったとして01.csvと同じ内容とします。
ここで、コードを簡略化するため、csvファイルの拡張子を除いた部分（01～04）をそのままシート名の番号部分に割り当てているのでcsvファイルの名称は必ず1から始まる連番にしてください（数値でなかったり連番でないとエラーになります）。

次の内容を例えばSample.vbsという名前で保存し01.csv～04.csvのファイルをドラッグしてこのSample.vbsにドロップすると処理が始まります。

'----Sample.vbs----
Set objArgs = WScript.Arguments
Set objAXLS = CreateObject("Excel.Application")
objAXLS.Visible = True
Set Book = objAXLS.WorkBooks.Add
n = objArgs.length - Book.Sheets.Count

If n > 0 Then
For i = 1 To n
Book.Sheets.Add
Next
End If
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")

Set objFS = CreateObject("Scripting.FileSystemObject")
For i = 0 To objArgs.length - 1
sn = CInt(objFS.GetBaseName(objArgs(i)))
sname = "Sheet" & CStr(sn)
Set f = objFS.OpenTextFile(objArgs(i), 1)
arrCSV = Split(f.ReadAll, vbCrLf)
temp = ""
For j = 0 To UBound(arrCSV) - 1
arrRow = Split(arrCSV(j), ",")
temp = temp & arrRow(sn-1) & vbCrLf
Next
objIE.document.parentwindow.clipboardData.SetData "text" , temp
With objAXLS
.Sheets(sname).Select
.Cells(1,sn).Select
.ActiveSheet.Paste
End With
Next
objIE.Quit
'----Code End----

Excelの場合セル毎に操作すると時間がかかるようなのでクリップボード経由でExcelに貼り付けてみました。

なおソースネクストのウィルスセキュリティゼロがあると、csvファイルを開こうとするとなんだか警告ダイアログが表れますorz

回答No.2

nda23

A.xlsを開いておきます。
メニューバーの「ツール(T)」→「マクロ(M)」→「新しいマクロの記録(R)」を順に選択します。
あとは01.CSVを開いて列のコピペなど、やりたいことをやって下さい。
そして、終わったら「記録終了」（画面中央にある小窓の□）を
クリックします。今までやった操作のマクロが出来ています。

回答No.1

DOUGLAS_

１）ＶＢＥ で 標準モジュールを挿入し、コードウィンドウに
Input
と入力します。
２）そこにカーソルを合わせて [F1] キーを押下すると、[Input キーワード] のヘルプが開きます。
３）[Line Input # ステートメント] をクリックします。
４）[Line Input # ステートメント] のヘルプで [使用例] をクリックします。
５）[Line Input # ステートメントの使用例] をご参考に。