[[20120206161956]] 『フォルダー内の複数のBOOKから 同じ項目を 別のBO』(ayakohana) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『フォルダー内の複数のBOOKから 同じ項目を 別のBOOKに一覧にする』(ayakohana)
Excel2003 Windows2000 です。

 はじめまして。マクロとか 何も分からない初心者です。
お忙しい所 恐縮ですが コピペの限界で 一部でも 同じ動作を 自動でできないかと思い
投稿させて頂きます。

 フォルダーに 50個のBOOKがあります。

 BOOKのスタイルは みんな同じで 品番・品名・単価・総数量・金額 → アクセスのカードスタイルの様に表示されてまして 
 品番はC3のセル、品名はC4のセル、単価はC5のセル、総数量はX5のセル、金額はX6のセルに入力されてます。

 総数量・金額 は数式からの結果となってます。

 横一列の 詳細は 3S・2S・S・M・L・2L・3L・4L・5L・6L となってまして
日々の プラスマイナスの結果が セルのX51から Y51・Z51・AA51..AG51 に出るような
計算式となってまして 結果が表示されてます。

 これを 1枚のBOOKに 横一列で 品番→6L(の結果の数量)まで 書き写す事はできないでしょうか?

 以上なのですが 説明不足な点もあるかと思いますが 何卒 お力をお貸し下さいますようお願い申し上げます。(お力お借りしても いつお返しできるか 分かりませんが 宜しくお願いします。)

 ayakohana


 なかなか解答がつかないですね。
 とりあえず簡単なマクロの例です。
 新規ファイルの1行目に項目名、2行目のB列以降に取得したい位置を記載して、
        A       B       C       D
1  ファイル名   品番    品名    単価    総数量  ・・・
2               C3      C4      C5      X5      ・・・
3

 下記を実行してみて下さい。

 Option Explicit
 Sub MakeDataList()
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim srcWS As Worksheet
    Set srcWS = ActiveSheet

    Dim folderPath
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show <> True Then Exit Sub
        folderPath = .SelectedItems(1)
    End With

    Dim row As Long
    Dim col As Long
    Dim lastCol As Long

    row = 3
    lastCol = srcWS.Range("B2").End(xlToRight).Column
    If lastCol = Columns.Count Then
        MsgBox "取得位置が範囲が未定義です "
        Exit Sub
    End If

    Dim file
    For Each file In fso.GetFolder(folderPath).Files
        With Workbooks.Open(folderPath & "\" & file.Name)
            srcWS.Cells(row, "A").Value = file.Name
            For col = 2 To lastCol
                srcWS.Cells(row, col).Value = .Worksheets(1).Range(srcWS.Cells(2, col).Value).Value
            Next
            .Close
            row = row + 1
        End With
    Next
 End Sub
 (Mook)

Mook様 おはようございます。
できました! ヽ(‘ ∇‘ )ノ ワーイ ありがとうございました。

 凄いですね〜。魔法の言葉です。
勉強して Mookさんが作ってくれた式を 理解できるようになりたいです。

 なんとお礼言っていいか分かりません。
 ありがとうございました。(。-_-。)
 ayakohana

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.