複数のcsvファイルから1つのExcelワークシートにデータをインポートして平均を計算する

Question

Excel 2010でマクロを作成しようとしていますが、未知数のセミコロンで区切られたcsvファイルサブフォルダをマスターブックのシーケンシャル列に移動します。マクロは、開いているマスターブックから実行する必要があります。

出発細胞は既知であるが、カラム範囲のサイズは変化し得る。

すべてのファイル名が異なります。

ファイル名が「ファイル名 - 60.00mm.csv」であれば、私は列ヘッダーとして、それが数としてフォーマットされるために、「60.00」を使用したい、

。これは、シート名の一部ではないため、csvブックの名前から取得する必要があります。私はこれをすることができた。

マスターブックの列Aには、「スキャン番号」というタイトルが付けられています。最大のデータ範囲には多くの行が必要ですが、行には1,2,3などの数字が入力されます。私はまだこれをどうやって解決するかは分かりません。

最も大きなデータ範囲の最後の塗りつぶし行の下の行に、ヘッダー行を除いて、上記のすべてのデータの平均を計算します。列Aのこの行のタイトルは「平均」である必要があります。私は平均を計算する方法を試しましたが、最大のデータ範囲の最後の行の下の行に出力する方法はわかりません。現在、データセットのすぐ下のセルにあります。

すべてのcsvファイルを検索してループし、関連するデータ範囲を選択してコピーするマクロを作成することができましたが、「アクティブ化」と「有効化」を使用しないで、選択 "します。また、列Aをスキップして列Bにペーストします。

また、各CSVファイルを順次開いたり閉じたりすることなく動作させることはできませんでした。

このコードを改善し、不足している部品を提供する最も効率的な方法は誰でも手伝ってください。

現在のコード： ます。Option Explicit サブインポート（）

Dim New_Path As String 
Dim CSV_WB As Workbook 
Dim Data As Variant 
Dim CSV_files As String 
Dim lastrow_CSV As Long 
Dim lastrow As Long 
Dim lastcol As Long 
Dim CSV_Sht_Name As String 
Dim CSV_Wbk_Title As String 
Dim averageRange As Variant 

New_Path = ThisWorkbook.Path & "Sub folder" 
CSV_files = Dir(New_Path & "*.csv") 

Do While Len(CSV_files) > 0 

    Workbooks.OpenText _ 
    Filename:=New_Path & CSV_files, _ 
    DataType:=xlDelimited, _ 
    Semicolon:=True, _ 
    Local:=True 

'Copy data. 
    Set CSV_WB = Workbooks(CSV_files) 
    CSV_Sht_Name = ActiveSheet.Name 
    CSV_Wbk_Title = Val(Left(Right(ActiveWorkbook.Name, 11), 5)) 
    lastrow_CSV = CSV_WB.Worksheets(CSV_Sht_Name).Range("C" & Rows.Count).End(xlUp).Row 

    Data = CSV_WB.Worksheets(CSV_Sht_Name).Range("C14:C" & lastrow_CSV).Copy 

'Paste Data 
    Windows("Master Workbook").Activate 

    lastcol = Cells(2, Columns.Count).End(xlToLeft).Column 

    Cells(1, lastcol).Offset(, 1).Value = CSV_Wbk_Title 

    Cells(1, lastcol).Offset(1, 1).Select 
    ActiveSheet.Paste 

'Add average. 
    lastrow = Cells(Rows.Count, lastcol + 1).End(xlUp).Row 

    averageRange = Range(Cells(2, lastcol + 1), Cells(lastrow, lastcol + 1)) 

    With Cells(lastrow + 1, lastcol + 1) 
     .Value = Application.WorksheetFunction.Average(averageRange) 
     .Font.Bold = True 
    End With 

    CSV_WB.Close 

    CSV_files = Dir 

Loop 

End Sub 

Answer 1

ここでは、各ファイルを開くことなく、マスターに直接データを読み取るために変更することができますいくつかのコードです。

'Created by Fredrik Östman www.scoc.se 
Dim objFSO As Object 
Dim objFolder As Object 
Dim objFile As Object 
Dim file_text_tmp As String 
Dim i As Integer 

Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFolder = objFSO.GetFolder("E:\") 

field_num = 3 
delimiter = ";" 

col = 1 
For Each objFile In objFolder.Files 
    Cells(1, col) = Val(Left(Right(objFile.Name, 11), 5)) 
    Open objFile.Path For Input As #1 
     Row = 2 
     Do While Not EOF(1) 
      Line Input #1, file_text_tmp 
      If field_num > 1 Then 
       For k = 1 To field_num - 1 
        file_text_tmp = Right(file_text_tmp, Len(file_text_tmp) - InStr(1, file_text_tmp, delimiter)) 
       Next k 
      End If 
      if InStr(1, file_text_tmp, delimiter) = 0 then 
       Cells(Row, col)=file_text_tmp 
      else 
       Cells(Row, col) = Left(file_text_tmp, InStr(1, file_text_tmp, delimiter) - 1) 
      end if 
      Row = Row + 1 
     Loop 
    Close #1 
    col = col + 1 
Next objFile 

Rows("2:14").Delete ' looks like you are only copying from row 14, which is row 15 in my code 

'Add average. 
Row = ActiveSheet.UsedRange.Rows.Count + 1 
For i = 1 To Col - 1 
    With Cells(Row, i) 
    .Value = Application.WorksheetFunction.Average(Range(Cells(2, i), Cells(Row - 1, i))) 
    .Font.Bold = True 
End With