エクセルマクロの製作をお願いします


フォルダ内に複数のcsvファイルが入っています。
このcsvファイルは入っている数値が違うだけの同一形式のデータです。
このファイル名が1行目に入り、2行目以降指定した列の数値を指定した行から指定した行まで左から順に入れていけるものです。

具体的には,ファイル名「A1.csv」「A2.csv」があり
「A1.csv」には1列目に1,2,3,4,5,6,が入っており
「A2.csv」には1列目に11,22,33,44,55,66,と入っている場合に
1列目の2行目から5行目までを選んだ場合、

A1  A2
2   22
3   33
4   44
5   55

というようになる物です。
分かりにくい場合は確認してください。
マクロ以外でもフリーで同一の事が出来るソフトがあれば教えてください。

回答の条件
  • 1人2回まで
  • 登録:2008/03/04 20:26:09
  • 終了:2008/03/05 12:46:17

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692008/03/04 22:12:26

ポイント35pt

とりあえず作ってみました。

inputboxで数字を入力するようにしてますが、無効な数字を入れるとエラーがでます。


Sub Macro()
    Dim startRow
    Dim endRow
    Dim c
    Dim i As Integer
    Dim j As Integer
    Dim l As Integer
    Dim textline, csvline() As String
    Dim ch1 As Long
    Dim FileNamePath As String
    Dim FSO
    Dim f
    
    'CSVのフォルダを指定
    Const FolderPath As Variant = "C:\Documents and Settings\hogehoge\デスクトップ\あるフォルダ\"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    startRow = Application.InputBox(Prompt:="開始行を入力してください。", Type:=1)
    If startRow = "False" Then Exit Sub

    endRow = Application.InputBox(Prompt:="終了行を入力してください。", Type:=1)
    If endRow = "False" Then Exit Sub
     
    c = Application.InputBox(Prompt:="表示列を入力してください。", Type:=1)
    If c = "False" Then Exit Sub
    
    j = 1
    '空いているファイル番号を取得します
    ch1 = FreeFile
    
    For Each f In FSO.getfolder(FolderPath).Files
        FileNamePath = FolderPath & "\" & f.Name
        
        Cells(1, j).Value = Left(f.Name, Len(f.Name) - 4)
        
        'FileNamePath のファイルをオープンします
        Open FileNamePath For Input As #ch1
        
        l = 2
        
        For i = 1 To endRow
            '1行読み込みます
            Line Input #ch1, textline
            
            If i >= startRow Then
                'カンマで分離します
                csvline() = Split(textline, ",")
        
                Cells(l, j).Value = csvline(c - 1)
                l = l + 1
            End If
        Next i
        
        j = j + 1
        
        Close #ch1
    Next f
    Set FSO = Nothing
End Sub
id:iwayuru_kami

有難うございます。

かなりイメージに近いマクロです。

もし出来れば、フォルダの指定を都度マクロ内で入れ替えるのではなく

マクロ実行時に選択できる用できないでしょか?

2008/03/05 08:39:27

その他の回答(1件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692008/03/04 22:12:26ここでベストアンサー

ポイント35pt

とりあえず作ってみました。

inputboxで数字を入力するようにしてますが、無効な数字を入れるとエラーがでます。


Sub Macro()
    Dim startRow
    Dim endRow
    Dim c
    Dim i As Integer
    Dim j As Integer
    Dim l As Integer
    Dim textline, csvline() As String
    Dim ch1 As Long
    Dim FileNamePath As String
    Dim FSO
    Dim f
    
    'CSVのフォルダを指定
    Const FolderPath As Variant = "C:\Documents and Settings\hogehoge\デスクトップ\あるフォルダ\"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    startRow = Application.InputBox(Prompt:="開始行を入力してください。", Type:=1)
    If startRow = "False" Then Exit Sub

    endRow = Application.InputBox(Prompt:="終了行を入力してください。", Type:=1)
    If endRow = "False" Then Exit Sub
     
    c = Application.InputBox(Prompt:="表示列を入力してください。", Type:=1)
    If c = "False" Then Exit Sub
    
    j = 1
    '空いているファイル番号を取得します
    ch1 = FreeFile
    
    For Each f In FSO.getfolder(FolderPath).Files
        FileNamePath = FolderPath & "\" & f.Name
        
        Cells(1, j).Value = Left(f.Name, Len(f.Name) - 4)
        
        'FileNamePath のファイルをオープンします
        Open FileNamePath For Input As #ch1
        
        l = 2
        
        For i = 1 To endRow
            '1行読み込みます
            Line Input #ch1, textline
            
            If i >= startRow Then
                'カンマで分離します
                csvline() = Split(textline, ",")
        
                Cells(l, j).Value = csvline(c - 1)
                l = l + 1
            End If
        Next i
        
        j = j + 1
        
        Close #ch1
    Next f
    Set FSO = Nothing
End Sub
id:iwayuru_kami

有難うございます。

かなりイメージに近いマクロです。

もし出来れば、フォルダの指定を都度マクロ内で入れ替えるのではなく

マクロ実行時に選択できる用できないでしょか?

2008/03/05 08:39:27
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912008/03/05 00:00:59

ポイント35pt

マクロの使用例ですが、下記のものでどうでしょうか。


2行目の Data_FolderPath に実際のデータのあるパスを記載して実行してみてください。

'--- CSV ファイルのあるフォルダパス:この中を処理
Const Data_FolderPath = "C:\Data"

Sub loadCSVFiles()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
'--- 選択セルの行範囲
    Dim startRow As Long
    startRow = Selection.Row
    
    Dim endRow As Long
    endRow = Selection.Row + Selection.Rows.Count - 1
    
'--- データ列
    Dim dCol As Long
    dCol = 1
    
    Dim aFile As Object
    Dim data As Variant
    For Each aFile In fso.getFolder(Data_FolderPath).Files
'--- CSV ファイルの確認
        If InStr(UCase(fso.GetExtensionName(aFile.Path)), "CSV") > 0 Then
   '--- ファイル名の記載
            Cells(1, dCol).Value = aFile.Name
            
   '--- データの読込み
            data = Split(fso.OpenTextFile(aFile.Path).ReadAll(), ",")
   '--- データの転記
            i = 0
            For j = startRow To endRow
                If UBound(data) < i Then
                    Cells(j, dCol).Value = ""
                Else
                    Cells(j, dCol).Value = data(i)
                End If
                i = i + 1
            Next
            dCol = dCol + 1
        End If
    Next
End Sub
id:iwayuru_kami

有難うございます。

実行は出来たのですが、行や列の指定が出来ないようです。

マクロ実行時に変更できるようにできないでしょうか?

2008/03/05 08:41:23
  • id:Mook
    列の指定はできませんが、行は実行時に選択されたセルサイズになっているはずです。

    フォルダ下のファイル数が不定なので、列数は実行前にわからないと思うのですが、
    どのような動作をご希望でしょうか。


    フォルダ選択は、
    (1)先頭の2行を削除
    (2)プロシージャの先頭に2行追加
    Sub loadCSVFiles()
      Dim oFolder As Object
      Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダ選択", 1)

    (3)For 文を下記に置き換え
      For Each aFile In fso.getFolder(oFolder.items.Item.Path).Files
    でできます。
  • id:iwayuru_kami
    Mookさん

    希望の動作としては、
    SALINGERさんに作っていただいたマクロに
    今Mookさんが書いてくれたフォルダ選択が合わさったような物です。
  • id:Mook
    「指定した」の意味を「選択していた」と勘違いしていたようです。

    SALINGER さんのコードをご利用ください。
  • id:SALINGER
    当初フォルダも選択するようにしようかとも思いましたが
    保存先はあまり変更はないだろうということと、
    入力が4回だと使いづらいかなということではぶきました。
    フォルダ選択はMookさんのコメントを組み込めばいいですね。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません