[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フォルダー内の複数の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.