このようなエクセルマクロを組みたいのですが...

質問

下記のようなマクロを組みたいと思っていますが、
知見がほとんどないので教えていただきたいと思います。

"csv"というフォルダにランダムなファイル名でcsv形式のファイルが100以上保存されています。
目的は、
そのcsvファイル内の一部のデータをひとつのファイル(ファイル名を"まとめ"とします)に移して並べたいと思います。

＜前提＞
"csv"フォルダと"まとめ"ファイルは既に開かれている状態とします。

"まとめ"ファイルを開いた状態で、マクロを走らせると、
(1)csvファイルが開く
(2)セルA1とB1をコピー
(3)"まとめ"ファイルのA1、A2へ貼り付け(行と列を変更)
(4)csvファイルを閉じる
(5)次のcsvファイルが開く
(6)セルA1とB1をコピー
(7)"まとめ"ファイルのB1、B2へ貼り付け(行と列を変更)
(8)csvファイルを閉じる
以降、"csv"フォルダの中身をすべて処理できるまで繰り返し。

という風に考えていますが、
当方あまり知識が無くアレンジが難しいためできる限りシンプルにと考えています。
そのため、もしこうした方が...等あればアドバイスいただけるとありがたいです。
すみませんがよろしくお願いいたします。

回答No.6

Prome_Lin · ベストアンサー

大変申し訳ございません。

私、チェック用のデータの作成を間違えていました。

Sub Sample()
Dim bk As Workbook, sh As Worksheet, ts As Worksheet
Dim a As Variant, b As Variant, i As Integer, c As Long
Dim f As String, p As String
Set ts = ThisWorkbook.ActiveSheet
a = Array(1, 19, 24, 29)
b = Array("B1", "B18", "B23", "F23", "B27", "F27", "C36", "C900")
p = "D:\Programing\Test_01"
f = Dir(p & "\*.csv")
c = 0
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do Until f = ""
Set bk = Workbooks.Open(p & "\" & f)
Set sh = bk.ActiveSheet
c = c + 1
For i = 0 To 3
sh.Range(b(i * 2) & ":" & b(i * 2 + 1)).Copy
If i = 1 Or i = 2 Then
ts.Range(ts.Cells(a(i), c), ts.Cells(a(i), c)).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Else
ts.Range(ts.Cells(a(i), c), ts.Cells(a(i), c)).PasteSpecial Paste:=xlPasteValues, Transpose:=False
End If
Next i
bk.Close
Set sh = Nothing
Set bk = Nothing
f = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

おっしゃるとおり、縦横の値の書き込みが間違っていました。

今回は、「Copy・Paste」を使って、縦横も正確に処理していると思うのですが・・・

申し訳ないのですが、今一度、ご確認ください。

お礼

目的通りの動作を確認できました。
最後までやり取りしていただき本当に感謝です。
この手の知識がある方は尊敬しますね。
私は生産技術をやってますが回答者様のような能力があれば仕事の効率が格段に上がると思います。
今回のをベースに色々勉強していきます。
ありがとうございました。

回答No.5

Prome_Lin

今一度、データを作成して、確認したのですが、

元B1～B18をコピー
まとめ先A1～A18へ入力

元B23～F23をコピー
まとめ先A19～A23へ入力

元B27～F27をコピー
まとめ先A24～A28へ入力

元C36～C900をコピー
まとめ先A29～A893へ入力

という前提条件が合っていれば、間違いなく動いています。

「B1～B18」→「A1～A18」など、合っていますか？

補足

度々すみません。

元B1～B18をコピー
まとめ先A1～A18へ入力
これはok

元B23～F23をコピー
まとめ先A19～A23へ入力
これはng
B23のみの値がすべて入っています。

元B27～F27をコピー
まとめ先A24～A28へ入力
これはng
B27のみの値がすべて入っています。

元C36～C900をコピー
まとめ先A29～A893へ入力
これはok

行方向のコピーから列方向へ並べて貼り付け、がうまくいってないのでしょうか。
マクロはそのままコピーしており指定するフォルダ名しか変更してないです。
状況の方伝わりますでしょうか。
すみませんがよろしくお願い致します。

回答No.4

Prome_Lin

遅くなり、申し訳ございません。

一応、動作確認はしたつもりなのですが、問題があれば言ってください。

今回は、「csv」ファイルを、テキストファイルとして読み込むのではなく、いったん、エクセルのファイルとして開いて、そこから指定の範囲の値を、マクロを走らせているブックに書き込んでいます。

★★★８行目を質問者の環境に合わせてから、実行してください★★★

Sub Sample()
Dim bk As Workbook, sh As Worksheet, ts As Worksheet
Dim a As Variant, b As Variant, i As Integer, c As Long
Dim f As String, p As String
Set ts = ThisWorkbook.ActiveSheet
a = Array(1, 18, 19, 23, 24, 28, 29, 893)
b = Array("B1", "B18", "B23", "F23", "B27", "F27", "C36", "C900")
p = "D:\Programing\csv_01\csv"
f = Dir(p & "\*.csv")
c = 0
Application.ScreenUpdating = False
Do Until f = ""
Set bk = Workbooks.Open(p & "\" & f)
Set sh = bk.ActiveSheet
c = c + 1
For i = 0 To 3
ts.Range(ts.Cells(a(i * 2), c), ts.Cells(a(i * 2 + 1), c)).Value = _
sh.Range(b(i * 2) & ":" & b(i * 2 + 1)).Value
Next i
bk.Close
Set sh = Nothing
Set bk = Nothing
f = Dir()
Loop
Application.ScreenUpdating = True
End Sub

一応、簡単な説明をしておきます。

Set ts = ThisWorkbook.ActiveSheet

「ThisWorkbook」は、マクロを走らせているブックで、「ActiveSheet」は、前面に出ている、処理対象になっているシートのことです。

a = Array(1, 18, 19, 23, 24, 28, 29, 893)
b = Array("B1", "B18", "B23", "F23", "B27", "F27", "C36", "C900")

指定の範囲を、配列変数に格納しています。

たとえば、「b(0) = "B1"」、「b(1) = "B18"」、・・・「b(7) = "C900」としています。

p = "D:\Programing\csv_01\csv"

「csv」ファイル群が存在するフォルダです。

f = Dir(p & "\*.csv")

そのフォルダ内の「csv」ファイルを読み込んでいます。

c = 0

実際に書き込む、列カウント用変数の初期化。

Application.ScreenUpdating = False

ファイルを開いたり閉じたりすると、画面がチカチカするのと、時間もかかるので、「画面の更新を停止」しています。

Do Until f = ""

そのフォルダ内の「csv」ファイルが処理し終わるまで繰り返し。

Set bk = Workbooks.Open(p & "\" & f)

「csv」ファイルを開いています。

Set sh = bk.ActiveSheet

そのファイルのアクティブシートを「sh」にセットしています。

これで、「sh.Range("A1").Value」などと記述すれば、「開いたブックのアクティブシートのセルA1の値」と記述しているのと同じで、今現在、どのブックやシートがアクティブになっているか気にする必要がありません。

c = c + 1

１列カウント。

For i = 0 To 3

全部で処理する範囲が４組ありますので、４回繰り返します。

ts.Range(ts.Cells(a(i * 2), c), ts.Cells(a(i * 2 + 1), c)).Value = _
sh.Range(b(i * 2) & ":" & b(i * 2 + 1)).Value

これで、１行です。

「i * 2」は、「i」が「0」のときは、「0、2、4、6」と変化します。

したがって、「i * 2 + 1」は、「1、3、5、7」です。

これは、「a = Array(1, 18, 19, 23, 24, 28, 29, 893)」に対応していて、「a(0) = 1」、「a(1) = 18」が１組、「a(2) = 19」、「a(3) = 23」が１組、「a(4) = 24」、「a(5) = 28」が１組、「a(6) = 29」、「a(7) = 893」が１組です。

またその下も「b(0) = "B1"」、「b(1) = "B18"」が１組で、「a(0)」、「a(1)」の組に対応しています。

これで、開いた「csv」ファイルは、セルの位置を固定で読み込んで、マクロを走らせているブックには、ファイルを開くごとに、横へ横へと書き足してゆきます。

Next i

を、４組実行しています。

bk.Close
Set sh = Nothing
Set bk = Nothing

ファイルを閉じています。

f = Dir()

ファイルを内容を更新しています。

Loop

を、「csv」ファイルがなくなるまで、繰り返します。

Application.ScreenUpdating = True

「画面の更新」を再開しています。

補足

ご丁寧に回答いただきありがとうございます。
動作の方確認しました。
一部のみデータがおかしい箇所がありますので確認していただけますでしょうか。度々申し訳ありません。

データコピー後ファイルのA列のみ捉えて言うと、
A19～A23とA24～A28の部分において、
同じ数字が並ぶようになってしまっています。

A19には元のB23の数字が入っており間違いはないですが、続いてのA20～A23にもB23の値が入っているようです。(ほんとはC23～F23の値が入ってほしい)

A24～A28でも同じ症状です。

その他は問題無さそうです。
すみませんがよろしくお願い致します。

回答No.3

Prome_Lin

こういうことでしょうか？

６行目の「p = "D:\Programing\Test_01\"」は、今は、私の環境ですので、質問者の環境に合わせてから、実行してください。

なお、「"csv"フォルダ」を開いておく必要はありません。

最後に、簡単な説明をしますので、読んで、質問者の使いやすいように変更してください。

Sub Sample()
Dim n() As String, f As String
Dim m As Long, p As String
Dim i As Long, j As Long
Dim x As String, a As Variant
p = "D:\Programing\Test_01\"
f = Dir(p & "*.csv")
m = -1
Do Until f = ""
m = m + 1
ReDim Preserve n(m)
n(m) = p & f
f = Dir()
Loop
For i = 0 To m - 1
For j = i + 1 To m
If n(i) > n(j) Then
x = n(i)
n(i) = n(j)
n(j) = x
End If
Next j
Next i
For i = 0 To m
Open n(i) For Input As #1
Line Input #1, x
a = Split(x, ",")
Close #1
Cells(1, i + 1).Value = a(0)
Cells(2, i + 1).Value = a(1)
Next i
End Sub

簡単な説明です。

p = "D:\Programing\Test_01\"

「csv」ファイル群が存在するフォルダを「p」に入れていますが、最後に「\」を忘れないでください。

f = Dir(p & "*.csv")

そのフォルダ内のすべての「csv」ファイルが「f」に入りました。

m = -1

「csv」ファイルの個数をカウントする変数の初期化。

Do Until f = ""

すべての「csv」ファイルを１つずつ処理。

m = m + 1

１個カウント（最初は「0」になります）。

ReDim Preserve n(m)

配列変数を用意。

n(m) = p & f

配列変数にフォルダとファイル名を格納しています。

f = Dir()
Loop

を、すべての「csv」ファイルで繰り返しています。

For i = 0 To m - 1
For j = i + 1 To m
If n(i) > n(j) Then
x = n(i)
n(i) = n(j)
n(j) = x
End If
Next j
Next i

念のため、ファイル名をソートしています。

For i = 0 To m

ソートされた結果の順番で読み込みます。

Open n(i) For Input As #1

ファイルを、「読み込み専用」で開いています。

Line Input #1, x

１行読み込んで、「x」に入れています。

a = Split(x, ",")

「Split()」というのは、区切り記号（今回はもちろん、「,」（カンマ）が区切り記号です）を使って配列変数に格納します。

たとえば、読み込んだ１行が、「a,b,c」の場合、「a(0) = "a"」、「a(1) = "b"」、「a(2) = "c"」となります。

この「a(0)」が、エクセルで言う「A1」に当たり、「a(1)」が「B1」に当たります。

Close #1

閉じています。

Cells(1, i + 1).Value = a(0)
Cells(2, i + 1).Value = a(1)

セルに書き込んでいます。

もちろん、ファイルを読み込むごとに、右へ右へと書き込んでいます。

Next i

を、すべての「csv」ファイルで繰り返しています。

補足

ご回答ありがとうございました。

データ取り込みのところでアレンジしようかと試みましたが理解不足で本当に申し訳ありません。詳細を書かせていただきますのでもう少しご教示いただけますでしょうか。

元B1～B18をコピー
まとめ先A1～A18へ入力

元B23～F23をコピー
まとめ先A19～A23へ入力

元B27～F27をコピー
まとめ先A24～A28へ入力

元C36～C900をコピー
まとめ先A29～A893へ入力

その後、まとま先はB列、C列と並んでいくといった感じです。

回答No.2

nan93850673

>"csv"フォルダと"まとめ"ファイルは既に開かれている状態とします。

既に「"csv"フォルダを開いている」というのは、どういった状態でしょうか

補足

分かりにくくて申し訳ありません。
"csv"フォルダは予めダブルクリックして開かれており、タスクバーに存在(表示)している状態という説明で分かりますでしょうか。
マクロで指定するよりそちらの方がシンプルになるかと思いましたのでそのような前提で考えました。よろしくお願い致します。

回答No.1

watabe007

Sub Test()
　　Dim objFSO As Object, objCsv As Object
　　Dim v As Variant, col As Long

　　Set objFSO = CreateObject("Scripting.FileSystemObject")
　　For Each objCsv In objFSO.GetFolder("F:\csv").Files 'ホルダーのパスを明記
　　　　If objCsv.Name <> "まとめ.csv" Then 'まとめ.csvファイルは除外処理
　　　　　　With objFSO.OpenTextFile(objCsv)
　　　　　　　　v = Split(.ReadLine, ",")
　　　　　　　　.Close
　　　　　　End With
　　　　　　col = col + 1
　　　　　　'まとめ.csvファイルがアクティブな状態
　　　　　　ActiveSheet.Cells(1, col).Value = v(0)
　　　　　　ActiveSheet.Cells(2, col).Value = v(1)
　　　　End If
　　Next
End Sub

お礼

今回は別の方の回答より試させていただきましたが、自身の勉強のためこのマクロも動作を確認してみます。ご回答ありがとうございました。