Excelのマクロに関する質問です。良い回答は、450ポイント差し上げます。

フォルダー内にあるエクセルのすべてのファイルから集計用ブックの各シートに順に貼り付ける。

※フォルダ内の【Aブック】には命名規則があり、各都道府県の名前がつけられています。
※【Bブック】シートにある製品名のみ、【Aブック】から値を取得したい。
※【Aブック】の製品名は半角カタカナ/全角カタカナが混在してます。

【Aブック】(sheet1)
 例:北海道ブック
3  製品名  付属品   数量
4  テレビ  スイッチ   3
5  ビデオ  リモコン  -5

【Bブック】(テレビシート)
3  都道府県  機器名  付属品   数量
4  北海道   テレビ  スイッチ   3
5  広島    テレビ  リモコン   5

【Bブック】(ビデオシート)
3  都道府県  機器名  付属品   数量
4  北海道   ビデオ  リモコン  -5
5  秋田    ビデオ  リモコン   2

マクロでの回答は、ソースも記述願います。
どうか宜しくお願いします。

回答の条件
  • 1人10回まで
  • 登録:2011/02/23 16:31:06
  • 終了:2011/02/24 12:24:45

ベストアンサー

id:taknt No.3

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/02/23 18:12:38

ポイント450pt

既にシートは 存在しているってことで 作成しないで その存在するシートのみ セットするようにしました。

Sub コピー作業()
'対象フォルダを指定してください。
'このフォルダに この集計用のブックは 入れないでください。
p = "C:\test\"

f = Dir(p & "*.xls", vbNormal)

Do While f <> ""
    Set w = Workbooks.Open(Filename:=p & f, UpdateLinks:=False, ReadOnly:=True)
    If Right(f, Len("ブック.xls")) = "ブック.xls" Then
        kenmei = Left(f, Len(f) - Len("ブック.xls"))
    Else
        kenmei = Left(f, Len(f) - Len(".xls"))
    End If
    
    For a = 4 To 65536
        seihin = w.Sheets("Sheet1").Cells(a, 1)
        If seihin = "" Then Exit For
        seihin = StrConv(seihin, vbWide)

        For Each myWS In ThisWorkbook.Worksheets
            If myWS.Name = seihin Then
                r = ThisWorkbook.Sheets(seihin).Cells(Rows.Count, 1).End(xlUp).Row + 1
                ThisWorkbook.Sheets(seihin).Cells(r, 1) = kenmei
                ThisWorkbook.Sheets(seihin).Cells(r, 2) = seihin
                ThisWorkbook.Sheets(seihin).Cells(r, 3) = w.Sheets("Sheet1").Cells(a, 2)
                ThisWorkbook.Sheets(seihin).Cells(r, 4) = w.Sheets("Sheet1").Cells(a, 3)
                
            Exit For
            End If
        Next

    Next a
    w.Close
    
    
    f = Dir
Loop

End Sub

id:anim130M

ありがとうございます。

2011/02/24 12:23:03

その他の回答(2件)

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/02/23 17:24:58

以下のソースを置く場所は 標準モジュールでも シートのところでもいいです。

Sub コピー作業()
'対象フォルダを指定してください。
'このフォルダに この集計用のブックは 入れないでください。
p = "C:\test\"

f = Dir(p & "*.xls", vbNormal)

Do While f <> ""
    Set w = Workbooks.Open(Filename:=p & f, UpdateLinks:=False, ReadOnly:=True)
    
    'ブック名になんとかブックとあったら そのブックは 除く
    'それ以外は そのまま県名とする
    If Right(f, Len("ブック.xls")) = "ブック.xls" Then
        kenmei = Left(f, Len(f) - Len("ブック.xls"))
    Else
        kenmei = Left(f, Len(f) - Len(".xls"))
    End If
    
    For a = 4 To 65536
        '製品名を取り出す
        seihin = w.Sheets("Sheet1").Cells(a, 1)
        If seihin = "" Then Exit For
        
        'その製品名のシートを作成する
        'ただし既にシートが作られていたら 作らない
        flg = True
        For Each myWS In ThisWorkbook.Worksheets
            If myWS.Name = seihin Then
                flg = False
            Exit For
            End If
        Next

        If flg Then
            ThisWorkbook.Sheets.Add.Name = seihin
            ThisWorkbook.Sheets(seihin).Cells(3, 1) = "都道府県"
            ThisWorkbook.Sheets(seihin).Cells(3, 2) = "機器名"
            ThisWorkbook.Sheets(seihin).Cells(3, 3) = "付属品"
            ThisWorkbook.Sheets(seihin).Cells(3, 4) = "数量"
        End If

        '製品のシートの一番下に追加する
        r = ThisWorkbook.Sheets(seihin).Cells(Rows.Count, 1).End(xlUp).Row + 1
        ThisWorkbook.Sheets(seihin).Cells(r, 1) = kenmei
        ThisWorkbook.Sheets(seihin).Cells(r, 2) = w.Sheets("Sheet1").Cells(a, 1)
        ThisWorkbook.Sheets(seihin).Cells(r, 3) = w.Sheets("Sheet1").Cells(a, 2)
        ThisWorkbook.Sheets(seihin).Cells(r, 4) = w.Sheets("Sheet1").Cells(a, 3)
    Next a
    w.Close
    
    
    f = Dir
Loop

End Sub
id:anim130M

回答いただきありがとうございます。

捕捉で記載してます、

【Bブック】シートにある製品名のみ、【Aブック】から値を取得したいとおもいます。

2011/02/23 17:59:44
id:taknt No.2

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/02/23 18:05:55

>※【Aブック】の製品名は半角カタカナ/全角カタカナが混在してます。

混在するから どうする?というのが 抜けてますので そのまま処理するようにしていましたが

とりあえず 全角に変換して 処理するように修正しました。

Sub コピー作業()
'対象フォルダを指定してください。
'このフォルダに この集計用のブックは 入れないでください。
p = "C:\test\"

f = Dir(p & "*.xls", vbNormal)

Do While f <> ""
    Set w = Workbooks.Open(Filename:=p & f, UpdateLinks:=False, ReadOnly:=True)
    
    'ブック名になんとかブックとあったら そのブックは 除く
    'それ以外は そのまま県名とする
    If Right(f, Len("ブック.xls")) = "ブック.xls" Then
        kenmei = Left(f, Len(f) - Len("ブック.xls"))
    Else
        kenmei = Left(f, Len(f) - Len(".xls"))
    End If
    
    For a = 4 To 65536
        '製品名を取り出す
        seihin = w.Sheets("Sheet1").Cells(a, 1)
        If seihin = "" Then Exit For
        seihin = StrConv(seihin , vbWide)
        
        'その製品名のシートを作成する
        'ただし既にシートが作られていたら 作らない
        flg = True
        For Each myWS In ThisWorkbook.Worksheets
            If myWS.Name = seihin Then
                flg = False
            Exit For
            End If
        Next

        If flg Then
            ThisWorkbook.Sheets.Add.Name = seihin
            ThisWorkbook.Sheets(seihin).Cells(3, 1) = "都道府県"
            ThisWorkbook.Sheets(seihin).Cells(3, 2) = "機器名"
            ThisWorkbook.Sheets(seihin).Cells(3, 3) = "付属品"
            ThisWorkbook.Sheets(seihin).Cells(3, 4) = "数量"
        End If

        '製品のシートの一番下に追加する
        r = ThisWorkbook.Sheets(seihin).Cells(Rows.Count, 1).End(xlUp).Row + 1
        ThisWorkbook.Sheets(seihin).Cells(r, 1) = kenmei
        ThisWorkbook.Sheets(seihin).Cells(r, 2) = seihin 
        ThisWorkbook.Sheets(seihin).Cells(r, 3) = w.Sheets("Sheet1").Cells(a, 2)
        ThisWorkbook.Sheets(seihin).Cells(r, 4) = w.Sheets("Sheet1").Cells(a, 3)
    Next a
    w.Close
    
    
    f = Dir
Loop

End Sub

id:taknt No.3

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/02/23 18:12:38ここでベストアンサー

ポイント450pt

既にシートは 存在しているってことで 作成しないで その存在するシートのみ セットするようにしました。

Sub コピー作業()
'対象フォルダを指定してください。
'このフォルダに この集計用のブックは 入れないでください。
p = "C:\test\"

f = Dir(p & "*.xls", vbNormal)

Do While f <> ""
    Set w = Workbooks.Open(Filename:=p & f, UpdateLinks:=False, ReadOnly:=True)
    If Right(f, Len("ブック.xls")) = "ブック.xls" Then
        kenmei = Left(f, Len(f) - Len("ブック.xls"))
    Else
        kenmei = Left(f, Len(f) - Len(".xls"))
    End If
    
    For a = 4 To 65536
        seihin = w.Sheets("Sheet1").Cells(a, 1)
        If seihin = "" Then Exit For
        seihin = StrConv(seihin, vbWide)

        For Each myWS In ThisWorkbook.Worksheets
            If myWS.Name = seihin Then
                r = ThisWorkbook.Sheets(seihin).Cells(Rows.Count, 1).End(xlUp).Row + 1
                ThisWorkbook.Sheets(seihin).Cells(r, 1) = kenmei
                ThisWorkbook.Sheets(seihin).Cells(r, 2) = seihin
                ThisWorkbook.Sheets(seihin).Cells(r, 3) = w.Sheets("Sheet1").Cells(a, 2)
                ThisWorkbook.Sheets(seihin).Cells(r, 4) = w.Sheets("Sheet1").Cells(a, 3)
                
            Exit For
            End If
        Next

    Next a
    w.Close
    
    
    f = Dir
Loop

End Sub

id:anim130M

ありがとうございます。

2011/02/24 12:23:03
  • id:taknt
    'ブック名になんとかブックとあったら そのブックは 除く

    ちょっと誤解を 与えやすい書き方だったので 修正 ↓

    'ブック名になんとかブックとあったら そのブックを除いた部分を県名にする
    '例 北海道ブック → 北海道
  • id:taknt
    >【Bブック】シートにある製品名のみ、【Aブック】から値を取得したいとおもいます。

    2番目に回答したものは これは 入っていません。
  • id:taknt
    >テレビシート

    これは 「テレビ」という名のシートという扱いにしちゃいました。

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

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

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

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