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