[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フォルダー内の複数のBOOKから 同じ項目を 別のBOOKに一覧にする』(ayakohana)
はじめまして。マクロとか 何も分からない初心者です。 お忙しい所 恐縮ですが コピペの限界で 一部でも 同じ動作を 自動でできないかと思い 投稿させて頂きます。
フォルダーに 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さんが作ってくれた式を 理解できるようになりたいです。
なんとお礼言っていいか分かりません。 ありがとうございました。(。-_-。) ayakohana
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
 Modified by kazu.