「取込」ボタン押下によって複数のCSVファイルを選択し、それぞれのデータをエクセルに縦表示したい

Question

前提・実現したいこと

「取込」ボタン押下によって複数のCSVファイルを選択し、それぞれのデータをエクセルに縦表示したいです。
１つのファイルのデータの表示は出来たのですが、複数のデータが表示できないため、アドバイスをいただけませんでしょうか。
乱雑で恐縮ですが、ソースコードを載せさせていただきます。
どうぞ、よろしくお願いいたします。

発生している問題・エラーメッセージ

複数のファイルを選択しても、１つのファイルのデータしか表示されない。

該当のソースコード

Sub 複数取込_Click()

    Dim wsData As Worksheet
    Set wsData = Worksheets("取込ボタン_複数ブック")

    Dim MaxRow As Integer
    MaxRow = wsData.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    Dim arrayPath As Variant
    Dim intFree As Integer
    Dim strRec As String
    Dim strSplit() As String
    
    arrayPath = Application.GetOpenFilename("CSVファイル(*.csv), *.csv", MultiSelect:=True)
    
    If IsArray(arrayPath) Then
    
        Application.ScreenUpdating = False
        
        Dim i As Integer
        For i = 1 To UBound(arrayPath)
        
            Dim j As Long, k As Long
            
            intFree = FreeFile
            Open arrayPath(i) For Input As #intFree
            
            j = 0
            Do Until EOF(intFree)
                Line Input #intFree, strRec
                j = j + 1
                strSplit = Split(strRec, ",")
                For k = 0 To UBound(strSplit)
                    Cells(j, k + 1) = strSplit(k)
                Next
            Loop
            
            Close #intFree
            
        Next i
        
        Range("A1:E2").Copy
        Range("A4").PasteSpecial Transpose:=True
        
        Range("A1:E2").Value = ""
        
        Application.CutCopyMode = False
        
        Application.ScreenUpdating = True
        
    End If

End Sub

Answer 1

ループ中の　j = 0　が不要ではないでしょうか。

このままだと、各CSVファイルからシートへの転記が
常にシートの先頭行となり、１ファイルの結果だけと
なってしまいます。

Comments

[shogakusha]

ありがとうございます。
複数のデータが表示されるようになりました。
ただ、別の問題が生じてしまったため、改めて質問させていただくかもしれません。
その際はどうぞよろしくお願いいたします。

Answer 2

Cells(j, k + 1) = strSplit(k)のところで、ファイルが変わっても同じ行に貼り付けているので、前の値が上書きされます。
ファイルが変わった際に、貼り付け開始行を変える必要があります。

また、読み込むファイルの数は可変だと思うのですが、
Range("A1:E2").CopyとRange("A4").PasteSpecial Transpose:=True
のセル範囲が固定になっているものおかしいです。
貼り付けたデータの範囲によってセル範囲を変える必要があります。

読み込むファイルは５列２行固定のデータなんでしょうか。
固定なら簡単に計算できると思いますが、可変だったら、CSVデータ読み込んだ際に行数列数を考慮する必要があります。

Comments

[shogakusha]

ありがとうございます。

> 読み込むファイルは５列２行固定のデータなんでしょうか。
固定のデータではありません。
その場合、行数列数を考慮する際は、MaxRowなどを設定したら良いのでしょうか。

続けてのの質問で申し訳ございません。
ご教授いただけると助かります。
よろしくお願いいたします。

[propg]

別の回答として書いたほうがいいんですが、修正してみた版です。

ファイルを読み込んだ際に、行数と列数をカウントしていきます。列数は読み込んだ全体の中で一番多い列数を保存しておきます。後でコピーするときの範囲とするためです。

コピーでは、カウントした行数列数を使ってコピー範囲を決めます。
ペーストでは、ペースト位置をすでに貼り付いている読み込みデータのすぐ下にしています。
ペースト後、要らなくなった元データもコピーのときのコピー範囲に対してクリアします。
最後、そのままでもいいんですが、上に空行が残ったままになっているので、上に詰めています。

最終的にどのように表示させたいのかがわからないので、意図した結果と違うかもしれません。

最初にMaxRowを設定していますが、データをどんどん追記していくつもりなんでしょうか。
今のサンプルは、毎回クリアして同じ位置に貼り付けていますので、追記でしたらMaxRow基準に行位置を加算していく必要があると思います。

Sub 複数取込_Click()

Dim wsData As Worksheet
Set wsData = Worksheets("取込ボタン_複数ブック")

Dim MaxRow As Integer
MaxRow = wsData.Cells(Rows.Count, 1).End(xlUp).Row + 1

' 前に設定した値をクリアする
wsData.Range("A1:Z1000").ClearContents

Dim arrayPath As Variant
Dim intFree As Integer
Dim strRec As String
Dim strSplit() As String
Dim intColCount As Integer
Dim intRowCount As Integer

arrayPath = Application.GetOpenFilename("CSVファイル(*.csv), *.csv", MultiSelect:=True)

If IsArray(arrayPath) Then

Application.ScreenUpdating = False

Dim i As Integer
For i = 1 To UBound(arrayPath)

Dim j As Long, k As Long

intFree = FreeFile
Open arrayPath(i) For Input As #intFree

j = 0
Do Until EOF(intFree)
Line Input #intFree, strRec
j = j + 1
intRowCount = intRowCount + 1
strSplit = Split(strRec, ",")

If intColCount < UBound(strSplit) + 1 Then
intColCount = UBound(strSplit) + 1
End If

For k = 0 To UBound(strSplit)
Cells(j + ((i - 1) * 2), k + 1) = strSplit(k)
Next
Loop

Close #intFree
Next i

'読み込んだ内容をコピーして貼り付ける
Dim copyRange As Range
Set copyRange = wsData.Range(wsData.Cells(1, 1), wsData.Cells(intRowCount, intColCount))

copyRange.Copy

'読み込んだデータの下に行列入れ替えて貼り付ける
wsData.Cells(intRowCount + 1, 1).PasteSpecial Transpose:=True

'コピー元の値をすべてクリアする
copyRange.ClearContents
'クリアした空き行を詰める
wsData.Range("1:" & intRowCount).Delete Shift:=xlUp
'選択状態を解除
wsData.Range("A1").Select

Application.CutCopyMode = False

Application.ScreenUpdating = True
End If

End Sub

[shogakusha]

詳細に説明していただき、ありがとうございます。
追加の質問で恐縮ですが、以下についてアドバイスをいただけませんでしょうか。

> 最終的にどのように表示させたいのかがわからないので、意図した結果と違うかもしれません。
例えば、以下２つのデータがあった場合、

id name age address date
1 佐藤　30　　東京　20200722

id name age address date
2 鈴木　40　　大阪　20200822

以下の様に、縦に表示させたいと考えています。

id 1
name 佐藤
age 30
address 東京
date 20200722

id 2
name 鈴木
age 40
address 大阪
date 20200822

教えていただいたソースで実行したところ、２つ目のデータについては、コピー&ペースト&削除がされませんでした。（私の打ち間違いでしたら申し訳ございません。）

どうぞ、よろしくお願いいたします。

[propg]

縦方向に並べたいということでしたら前のプログラムでは実現できません。
以下にサンプル提示します。
表示のさせ方については、行位置、列位置を把握していればどのようにでも配置はできると思います。

処理の途中でブレークポイントを指定して止め、現在位置などを確認していきながら作成します。

このサンプルでは読み込んだデータを横にずらずらと並べていき、最後のコピペで横長を縦長に貼り付けるという形です。
EXCEL横列の最大値は縦ほど大きくないので、読み込むデータが大量になった場合、限度があります。

Sub 複数取込縦_Click()

Dim wsData As Worksheet
Set wsData = Worksheets("取込ボタン_複数ブック")

Dim MaxRow As Integer
MaxRow = wsData.Cells(Rows.Count, 1).End(xlUp).Row + 1

' 前に設定した値をクリアする
wsData.Range("A1:Z1000").ClearContents

Dim arrayPath As Variant
Dim intFree As Integer
Dim strRec As String
Dim strSplit() As String
Dim intColCount As Integer
Dim intRowCount As Integer

arrayPath = Application.GetOpenFilename("CSVファイル(*.csv), *.csv", MultiSelect:=True)

If IsArray(arrayPath) Then

Application.ScreenUpdating = False

Dim intCurrentCol As Integer
Dim i As Integer
For i = 1 To UBound(arrayPath)

Dim j As Long, k As Long

intFree = FreeFile
Open arrayPath(i) For Input As #intFree

j = 0
k = 0
Do Until EOF(intFree)
Line Input #intFree, strRec
j = j + 1
intRowCount = intRowCount + 1
strSplit = Split(strRec, ",")

For k = 0 To UBound(strSplit)
Cells(j, intColCount + k + 1) = strSplit(k)
Next
Loop
intColCount = intColCount + UBound(strSplit) + 2

Close #intFree
Next i

'読み込んだ内容をコピーして貼り付ける
Dim copyRange As Range
Set copyRange = wsData.Range(wsData.Cells(1, 1), wsData.Cells(intRowCount, intColCount))

copyRange.Copy

'読み込んだデータの下に行列入れ替えて貼り付ける
wsData.Cells(intRowCount + 1, 1).PasteSpecial Transpose:=True

'コピー元の値をすべてクリアする
copyRange.ClearContents
'クリアした空き行を詰める
wsData.Range("1:" & intRowCount).Delete Shift:=xlUp
'選択状態を解除
wsData.Range("A1").Select

Application.CutCopyMode = False

Application.ScreenUpdating = True
End If
End Sub

[shogakusha]

ありがとうございます。
縦に表示することができました。
理解できていない箇所もありますが、勉強頑張ります。
本当にありがとうございました。

Answer 3

複数のファイルの各データをどのように出力するのかイメージがわきませんが、
Openのたびにjを0に初期化しているからでは？
j = 0をFor文の外にだしてみては？

Comments

[shogakusha]

ありがとうございます。
ご指摘通りに修正したところ、複数のデータが表示されるようになりました。
ただ、別の問題が生じてしまったため、改めて質問させていただくかもしれません。
その際はどうぞよろしくお願いいたします。