id:anim130M
ポイントあり450ptベストアンサーあり
ビジネス・経営コンピュータ

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/24 12:24:45
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:taknt No.3

回答回数13539ベストアンサー獲得回数1198

ポイント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ベストアンサー獲得回数1198

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

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ベストアンサー獲得回数1198

＞※【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ベストアンサー獲得回数1198ここでベストアンサー

ポイント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

コメント（3件)

  • id:taknt
    きゃづみぃ 2011/02/23 17:28:56
    'ブック名になんとかブックとあったら そのブックは 除く

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

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

    2番目に回答したものは これは 入っていません。
  • id:taknt
    きゃづみぃ 2011/02/24 11:10:36
    ＞テレビシート

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

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

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

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

回答リクエストを送信したユーザーはいません
ユーザー登録をして使いはじめる!無料
すでに登録されている方はこちらからログイン
この質問に含まれるキーワード
知りたいことを検索してみよう
▲ページトップへ