[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数ファイル内の同一セルデータを別ファイルに一覧にしたい』（ももも）
マクロ、VBEなど聞いたことはありますが全く使ったことがありません。
職場でのデータ作成のために以下のことをしたいと考えています。
状況
フォルダ内に３００程のエクセルファイルが存在。
各エクセルファイルに同一フォーマットでデータが記入されており、同じセルに同じ項目のデータが入っている。
例
ファイル１
（A,1)住所 （B,1)TEL (C,７)郵便番号 (D,４)プロジェクト名
(A,2)東京都 (B,2)03-888-3333 (C,8)999-6666 (D,5)ABCproject ファイル２ （A,1)住所 （B,1)TEL (C,７)郵便番号 (D,４)プロジェクト名 (A,2)沖縄県 (B,2)099-888-3333 (C,8)777-8888 (D,5)ニッポンproject
上のように項目名と項目データは上下に位置し、各項目はフォーマット上で離れている箇所もありますが、フォーマットは全てのファイルで同一です。
最終的に以下のように最初の行に項目名を並べ各列にデータを並べる形にしたい。
例
(A,1)住所 (B,1)TEL (C,1)郵便番号 (D,1)プロジェクト名
(A,2)東京都 (B,2)03-888-3333 (C,2)999-6666 (D,2)ABCproject
(A,3)沖縄県 (B,3)099-888-3333 (C,3)777-8888 (D,3)ニッポンproject
複数のファイルを同時に（あるいは短時間で）処理する仕方がわかりません。VBEにいたっては完全に？です。
最終的にはこのデータをリスト（テキストファイル）にしてアクセスにインポートして作業をしたいのですが、アクセス内でデータをいじった経験はあるのですが、インポートするための元データを作るということをしたことがなく質問いたしました。
お力添えお願いいたします。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
とりあえず過去の事例ですけれど、参考にならないでしょうか。 [[20120206161956]] 『フォルダー内の複数のBOOKから 同じ項目を 別のBOOKに一覧にする』（ayakohana）
（Mook） 2014/01/09(木) 07:50
>VBEにいたっては完全に？です。 とのことなので、一応実行方法の補足です。
EXCEL で ALT+F11 で VBE を起動。 VBE で 挿入⇒標準モジュール、 コードをコピー、VBE を閉じる。 EXCEL に戻って ALT＋F8 で MakeDataList を実行です。 （Mook） 2014/01/09(木) 09:08
もし各ファイルのシート名が統一されているのであれば
Sub test()
Dim myDir As String, fn As String, flg As Boolean
Const sn As String = "Sheet1" '<---- 要変更
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then myDir = .SelectedItems(1) & "\"
End With
If myDir = "" Then Exit Sub
fn = Dir(myDir & "*.xls")
Do While fn <> ""
If Not flg Then
Sheets(1).Cells(1).Resize(, 4).Formula = _
"='" & myDir & "[" & fn & "]" & sn & "'!a1"
flg = True
End If
Sheets(1).Range("a" & Rows.Count).End(xlUp)(2).Resize(, 4).Formula = _
"='" & myDir & "[" & fn & "]" & sn & "'!b1"
fn = Dir
Loop
End Sub
（seiya） 2014/01/09(木) 10:08
過去質をみて、試しに2つの以下のようなエクセルファイルを作ってそれを別ファイルにデータ抽出するようにしてみたかったのですがうまくできませんでしたので教えてください。
私がしたこと＞
１、エクセルファイルにデータの値は適当に変えて以下のように入力し２つサンプルファイルを作成（各「カルタ１」「カルタ２」とします、シート名はどちらもSheet1のまま）
A B C D
1 住所 郵便番号 名前 電話番号
2 東京 000-5555 山田 000-5888
3
２、別のファイル（「抽出ファイル」とします）に過去質問の回答にあったように入れたいセルの位置を入力
A B C D
1 住所 郵便番号 名前 電話番号
2 A2 B2 C2 D2
3
２のファイルを開いている状態でAlt＋F11でVBEを開き、挿入、モジュールを選択し、コードをそのままコピペ、Alt＋F11でExcelに戻る（他はいっさい触ってません）
Alt＋F8でMakeDataListを実行（MakeDateListと出ていたので何も変更せずにそのまま実行をしました）
すると、フォルダを選択するような画面が出たので上記の２つのサンプルファイルと抽出ファイルの入っているフォルダを選択し、OKを押しました。（しかし、画面上には対象になるファイルがないというような文字が出ていて、上記の3ファイルが見えない状態でした。が、よくわからなかったのでそのままOKにしました。
結果、A列にファイル名"カルタ１.xlsx."、"カルタ２.xlsx."が入り、B,C,D列は正しく入っている状態でした。
しかし別ウィンドウが開きそこに、「このファイルはすでに開かれています。再び開くと実行された操作が消去されるおそれがあります。開きますか？といった内容の忠告が出ます。そのまま開くと忠告どおり、抽出されたデータが消え、NOとするとVBE画面が開き、RUNTIme1004エラー 「手順「Workbookを開く」が実行できませんでした。という内容の文字が出ます。その下にFineとDebugと出で、Debugを選択するとコード内のWith Workbooks.Open(folderPath & "\" & file.Name)の部分が黄色く反転します。
以下質問
１、VBEを開くのは抽出ファイルを開いた状態で、カルタ１カルタ２は閉じた状態でしましたがあっていますか？（実際にしたい作業のファイルは３００ほどあるので全部開いての作業は無理だと思って閉じてしました。）
２、A列にデータが入らないのはどうすればなおりますか？コードを何か変更したり追加したりしないといけないのでしょうか？
３、フォルダを選択する際フォルダを選択すると中身が入ってないような画面になるのですがそれであっているのでしょうか？
４、コード内のMsgBox "取得位置が範囲が未定義です "の部分がVBEにコピペすると "????????"となります。言語設定が日本語でないとこうなるのでしょうか？イタリア語でのExcelを使用しています。
５、VBEの実行をした後に出てくる忠告内容に対してどう進めればよいのでしょうか。？忠告内容はイタリア語で出てきたのを日本語に訳しています。
本当にど素人なので、質問内容が意味不明かもしれませんが、できるだけ詳細に全てのステップを教えていただけるとありがたいです。
お手数おかけしますがよろしくお願いします。
（ももも） 2014/01/10(金) 02:02
遅い時間でのアクセスだと思いましたが、 Buon giorno のお国でしょうか。
それはさておき、 マクロを実行する手順は正しいです。 実行時の選択はフォルダを選択するので、ファイルは見えていません。
おそらく、マクロを書いたファイル（２）とデータが同じフォルダにあるのではない でしょうか。
実行するマクロはデータフォルダとは別の想定だったので、一緒の場合そのような 動作になってしまうと思います。
最後の部分を
For Each file In fso.GetFolder(folderPath).Files
If file.Name <> Thisworkbook.Name Then '// 追加
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
End If '// 追加
Next
とするか、 マクロを実行するファイルを別フォルダに置き、フォルダ内はデータファイルだけにして、 他のEXCEL ファイルが開いていない状態で実行するのが混乱ないと思います。
２は、Ａ列はどのファイルからデータをとってきたかわかるようにファイル名にして いるので、データ列はＢ列からにして、不要であれば収集後にＡ列を削除してください。
４に関しては VBE は UNICODE 対応していないので、Windows の言語設定が日本語で ない場合 VBE 内では日本語を記述できません。 ですのでメッセージは ‘La posizione di dati è indefinita' のように（自信なし） 変更してください。
不明な点は再度コメントください。
Ciao! （Mook） 2014/01/10(金) 07:53
おっしゃるとおりイタリアから質問させていただいてます。
なかなか詳しい情報が見つけられず、こちらにたどり着いた次第です。
うまくデータを取り出すことができました！感動！すごいですね！！！
追加で2点質問させてください！
１、前回のレスでMsgBox "取得位置が範囲が未定義です "の部分の文字変更する話が出ましたが、変更してもしなくても結果は同じようになりました。この部分はどういう指示がなされているコードなのでしょうか？何らかの場合にこのメッセージがセルに記入されるとかですか？
２、最後の保存の方法はどうしたらいいのでしょうか？
マクロを残して保存するには保存ファイルの種類を選ばないといけないと出るのですが、どれを選べばいいのでしょうか？
それともマクロを残さずに保存するにしたほうがいいのでしょうか？
マクロを残して保存する場合と残さずに保存する場合のメリットデメリットがよくわかりません。
マクロを残して保存すれば今後、同フォーマットであれば、他のフォルダのファイルからも抽出できるということでしょうか？この場合前回に抽出したデータの最終行の下に追加されていくのでしょうか？
重ね重ね申し訳ありませんが、もう少しお付き合いいただければ大変ありがたいです。
よろしくお願いいたします。
（ももも） 2014/01/10(金) 18:31
Buona sera, イタリアにお住まいとは羨ましいです。 名所が多くて、食べ物もおいしそうという印象ですが、お仕事はやはり大変ですよね。
まずはうまくいったようで何よりです。
１、MsgBox はシートの参照の定義がうまくできていないときのものなので、うまく収集 できる場合は実行されません。ので無くとも動作には影響しません。
２、保存ファイルにマクロはあっても無くてもいいですが、作成したデータの運用には 必要ありませんのでマクロを削除するか、シートを別のファイルにコピーして保存すれば いいと思います。
再実行した場合は指定フォルダを再検索して3行目から上書きしてしまうので、追記は できません。
今後もデータを追加していくような運用の場合は、マクロをを見直す必要がありますので、 その際は別途やりたい内容を説明されてはと思います。
Arrivederci （Mook） 2014/01/10(金) 22:31
おかげさまでやりたいと思っていたファイルの作成ができそうな感じです。試しに実際の幾つかのファイルを使って実行してみました。
実際にやってみてあらたに気づいた問題点が２点あります。お知恵を拝借できますでしょうか。
１、各ファイル内のフォーマットの中にチェックボックスにチェックを入れて選択する部分が数カ所ある。
チェックボックスはエクセルの開発タブに入ってる標準のもので、チェックボックスとチェック項目はセルが別れています。
他の項目と同じようにセル指定をして抽出してみましたが、当然ですが何も抽出されませんでした。
２、一項目にデータ内容が２つ以上ある項目が数カ所ある。
実務者を入力している項目で、１項目に対して２人、または３人（全ファイルを確認していないのでそれ以上の場合もあるかも。。。）。抽出する際一つのファイルから一項目に対して２つ以上のデータを縦に並べるというのは想定していないコードと理解しましたので、今回は横に並べて２人まで抽出しました。
理想
１、チェックボックスにチェックが入っている場合は１、入っていない場合は０（あるいはTrue/Forse）など、データが入るようにしたい。他のデータ抽出と同時にこれができれば理想だが、無理ならば、まず先にチェックボックスのチェックを別ファイルにファイル名と１/０（True/Forse)などに置き換えて抽出したい。
２、実務者の人数が増えても書き出せるようにしたい。
ファイル名１ データA データB データC データD データE 実務者あ 実務者あコード データ H データI
ファイル名１ データA データB データC データD データE 実務者い 実務者いコード データ H データI
ファイル名２ データAA データBB データCC データDD データEE 実務者か 実務者かコード データ HH データII
ファイル名２ データAA データBB データCC データDD データEE 実務者き 実務者きコード データ HH データII
ファイル名２ データAA データBB データCC データDD データEE 実務者く 実務者くコード データ HH データII
上のように各実務者に対して他のデータが重複して存在するような感じになれば ありがたいです。 これも他の抽出と一緒にできれば良いのですが、無理ならば、別ファイルにファイル名と実務者関係の項目だけ書き出して後でくっつける形でもかまいません。
わかりにくかったら申し訳ありません。
どうぞよろしくお願いいたします。
（ももも） 2014/01/14(火) 03:39
チェックボックスは開発⇒挿入の中の上段（フォームコントロール）と 下段（ActiveX コントロール）とどちらでしょうか。
２に関しては、今回 Access に登録するためのデータをまとめるということだったと 思いますが、複数データを1項目にしたいのでしょうか、それとも個別に登録したい のでしょうか。
それによって、データの集め方も異なってくると思います。 （Mook） 2014/01/15(水) 00:57
早速回答いただきありがとうございます。
１、チェックボックスはフォームコントロールの方です。
２、すみません。複数データを一項目にというのと、個別に登録というのが違いがわかりません。簡単な例を挙げていただけないでしょうか？
よろしくお願いいたします。
ももも
（ももも） 2014/01/15(水) 02:55
とりあえず２に関して。 アクセス側の実務者を入力する欄が、実務者１、実務者２、実務者３と複数あるのか、 実務者という一つの欄に、"実務者１、実務者２、実務者３" というに複数のデータを 一箇所に登録するのかということです。
１に関してはチェックボックスの読込指定を入れればよいと思いますがコントロールの 種類によってやり方が異なるので、確認しました。 マクロの変更は後ほど。 （Mook） 2014/01/15(水) 07:52
２に関して、おっしゃっていただいた後者の方「実務者という一つの欄に、"実務者１、実務者２、実務者３" というに複数のデータを
一箇所に登録する」です。 うまく説明できず申し訳ありません。
あと、もう一点質問です。
フォーマット上でデータが入っているセルが結合セルの場合どのようにセル指定をするのが正しいでしょうか？
試しにしてみたときは、G２０・H２０のセルが結合しているセルにデータが入っていて、そこのセル指定はG２０として抽出をしたところ正しく抽出されているようでした。やり方としては結合セルの場合、最左列上行のセルを指定セルにすればよいのでしょうか？（実際のフォーマットには列の結合はあっても行の結合はないですが）
よろしくお願いいたします。
（ももも） 2014/01/15(水) 08:36
変更のついでに下記のように仕様を変更しました。
・繰り返し実行した場合、リストに無いファイルだけを後ろに追加登録するように変更。 ・セルのアドレス記述を複数アドレス記述できるように変更。 例) C3:C5 C3:E3 C3,C5,C7 など ・フォームコントロールのチェックボックス 値の取得機能を追加 例）[B3] のようにチェックボックスの左上のセルを[ ]で囲んで指定 左上セルは文字や□ では無く、オブジェクトの位置ですので開発のデザインモードで チェックボックスを選択し、破線の左上のセルを指定してください。 セル結合している場合も、左上のセルを指定です。
[追加]：
・SEPARATE_MODE の追加。
・フォームコントロールのチェックボックス 値の取得機能（キャプション版）を追加
例）{チェック有} のようにチェックボックスのキャプションを{ }で囲んで指定
・フォームコントロールのチェックボックス 値の取得機能（キャプション版）を追加
例）$CheckBox1$ のようにチェックボックスの名前を $ $ で囲んで指定
Option Explicit
Public Const SEPARATE_MODE = True Public Const DELIMITER = vbLf ' // 区切り文字指定 : セル内改行 'public Const DELIMITER = ","
'-----------------------------
Sub MakeDataList()
'-----------------------------
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim dataWS As Worksheet
Set dataWS = ActiveSheet
Dim folderPath
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> True Then Exit Sub
folderPath = .SelectedItems(1)
End With
Dim dstRow As Long
Dim dstCol As Long
Dim lastCol As Long
dstRow = dataWS.Cells(Rows.Count, "A").End(xlUp).Row + 1
If dstRow < 3 Then dstRow = 3
lastCol = dataWS.Range("B2").End(xlToRight).Column
If lastCol = Columns.Count Then
MsgBox "Data definition is not valid"
Exit Sub
End If
Dim file
Dim mData
Dim i As Long
Dim dataNum As Long
Dim multipleDataMax As Long
Dim colDic
Set colDic = CreateObject("Scripting.Dictionary")
Dim colKey
'// Check multiple data column
For dstCol = 2 To lastCol
If InStr("{[$", Left(dataWS.Cells(2, dstCol).Value, 1)) = 0 Then
If Range(dataWS.Cells(2, dstCol).Value).Cells.Count > 1 Then
colDic(dstCol) = dataNum
End If
End If
Next
For Each file In fso.GetFolder(folderPath).Files
If dataWS.Columns("A:A").Find(file.Name, LookAt:=xlWhole) Is Nothing Then
With Workbooks.Open(folderPath & "\" & file.Name)
dataWS.Cells(dstRow, "A").Value = file.Name
multipleDataMax = 0
For dstCol = 2 To lastCol
dataWS.Cells(dstRow, dstCol).Value = getDataFromWS(.Worksheets(1), dataWS.Cells(2, dstCol).Value, dataNum)
If dataNum > multipleDataMax Then multipleDataMax = dataNum
Next
.Close savechanges:=False
'// Multi Data Column Processing
If SEPARATE_MODE = True And multipleDataMax > 1 Then
For i = 1 To multipleDataMax - 1
dataWS.Rows(dstRow).Copy dataWS.Rows(dstRow + i)
Next
For Each colKey In colDic.keys
mData = Split(dataWS.Cells(dstRow, colKey).Value & Application.Rept(DELIMITER, multipleDataMax), DELIMITER)
For i = 0 To multipleDataMax - 1
dataWS.Cells(dstRow + i, colKey).Value = mData(i)
Next
Next
dstRow = dstRow + multipleDataMax
Else
dstRow = dstRow + 1
End If
End With
End If
Next
End Sub
'-----------------------------
Function getDataFromWS(ws As Worksheet, srcAddr As String, ByRef dataNum As Long)
'-----------------------------
Dim cellAddr As String
Dim cbCaption As String
Dim cbName As String
Dim dc As Range
Select Case True
Case InStr(srcAddr, "[") = 1
cellAddr = Replace(Replace(srcAddr, "[", ""), "]", "")
getDataFromWS = _
getFormCheckBoxByCell(ws.Range(cellAddr))
Case InStr(srcAddr, "{") = 1
cbCaption = Replace(Replace(srcAddr, "{", ""), "}", "")
getDataFromWS = _
getFormCheckBoxByCaption(ws, cbCaption)
Case InStr(srcAddr, "$") = 1
cbName = Replace(srcAddr, "$", "")
getDataFromWS = _
getFormCheckBoxByName(ws, cbName)
Case Else
getDataFromWS = ""
dataNum = 0
For Each dc In ws.Range(srcAddr)
If dc.Value <> "" Then
getDataFromWS = getDataFromWS & IIf(dataNum > 0, DELIMITER, "") & dc.Value
dataNum = dataNum + 1
End If
Next
End Select
End Function
'-----------------------------
Function getFormCheckBoxByCell(cbCell As Range)
'-----------------------------
getFormCheckBoxByCell = "Not Found"
Dim cb As CheckBox
For Each cb In cbCell.Parent.CheckBoxes
If Not Intersect(cb.TopLeftCell, cbCell) Is Nothing Then
getFormCheckBoxByCell = IIf(cb.Value > 0, True, False)
Exit Function
End If
Next
End Function
'-----------------------------
Function getFormCheckBoxByCaption(ws As Worksheet, cbCaption As String)
'-----------------------------
getFormCheckBoxByCaption = "Not Found"
Dim cb As CheckBox
For Each cb In ws.CheckBoxes
If cb.Caption = cbCaption Then
getFormCheckBoxByCaption = IIf(cb.Value > 0, True, False)
Exit Function
End If
Next
End Function
'-----------------------------
Function getFormCheckBoxByName(ws As Worksheet, cbName As String)
'-----------------------------
getFormCheckBoxByName = "Not Found"
Dim cb As CheckBox
For Each cb In ws.CheckBoxes
If cb.Name = cbName Then
getFormCheckBoxByName = IIf(cb.Value > 0, True, False)
Exit Function
End If
Next
End Function
（Mook） 2014/01/15(水) 18:42
ありがとうございます！
データの追加までできるようになるなんて最高です！！
わたしのあたまがMook様の神業に追いつかないので教えてください！！
・フォームコントロールのチェックボックス 値の取得機能を追加
例）[B3] のようにチェックボックスの左上のセルを[ ]で囲んで指定 左上セルは文字や□ では無く、オブジェクトの位置ですので開発のデザインモードで チェックボックスを選択し、破線の左上のセルを指定してください。
の部分が理解できませんでした。
１、たとえばチェックボックスがフォーマットのG20セルに位置している場合、左上のセル=F19が指定アドレスとなり、抽出先のファイルには[F19]と入力するということでしょうか？それとも[G20]がただしいですか？
２、左上セルは文字や□ では無く、オブジェクトの位置ですので開発のデザインモードで
チェックボックスを選択し、破線の左上のセルを指定してください。 とのことですが、この部分がまったくわかりません。抽出ファイル（マクロを貼る方）を開いて、そこで開発のデザインモードですか？破線とはどこのことでしょうか。。。
お手数おかけして本当に申し訳ありません。もう少し詳しく教えてください。
よろしくお願いいたします。
ももも
（ももも） 2014/01/15(水) 19:39
参照先は ActiveX コントロールの例ですけれど、 http://www4.synapse.ne.jp/yone/excel2010/excel2010_x_checkbox.html
のような感じです（「チェックボックスをシートに配置する」の２の絵だと おそらくD4。ちょっとでも左上にはみ出していればC3）。
一応アクティブシートのセル位置を列挙するマクロです。
Sub FormCheckBoxInfo()
Dim cb As CheckBox
Dim res As String
res = "Form checkbox information"
For Each cb In ActiveSheet.CheckBoxes
res = res & vbNewLine & cb.Caption & "[" & cb.Name & "] .... " & cb.TopLeftCell.AddressLocal(False, False)
Next
MsgBox res
End Sub
※[] の中がチェックボックスのコントロール名
（Mook） 2014/01/15(水) 20:04
チェックボックスのところわかりました！ありがとうございます！！
チェックボックスのセル位置を確認してみることができたのですが、一部セルがダブってしまっているところがあります。二つのチェックボックスの指定セルが同じセルになってしまい、同じ値が出てきてしまいます。これはどうにかできるでしょうか?
あと、・セルのアドレス記述を複数アドレス記述できるように変更。
例) C3:C5 C3:E3 C3,C5,C7 など
なのですが、実際に範囲を入れて抽出してみたところ、たとえば実務者名前という項目に対して元のフォーマットではC3,C4,C5に各名前が入っているのを抽出した先では、C3,C4,C5 の名前がくっついて一つのセルに入ります。
フォーマットで下記のようになっているのを、
ファイル１
（C2）実務者名（項目） （D2）実務者番号（項目）
（C3）たなかたろう （D3）2356
（C4）やましたけいこ （D4）6621
（C5）すずきいちろう （D5）8524
ファイル2
（C2）実務者名（項目） （D2）実務者番号（項目）
（C3）やまだはなこ （D3）5524
（C4）なかたひでこ （D4）7745
（C5） 空白 （D5）空白
できれば下記のように各人をセルを分けていれたいのです。そしてそのほかのデータは重複して抽出される。（一つのファイルに対して実務者の数だけ行が存在するということ）
A B C D E F … I …
１ ファイル名１ データB データC データD たなかたろう 2356 …データI
２ ファイル名１ データB データC データD やましたけいこ 6621 … データI
３ ファイル名１ データB データC データD すずきいちろう 8524 … データI
４ ファイル名２ データBB データCC データDD やまだはなこ 5524 … データII
５ ファイル名２ データBB データCC データDD なかたひでこ 7745 … データII
６ ファイル名３ 。。。。。。。。
もしかしたら前回おっしゃっていただいた前者のほうに当たっているかもしれません。読解力がなく申し訳ありません。
理想は各実務者名からもその他のデータをつなげられるようにしたいので、名前が一つのセルにまとまるとやりにくくなります。
本当に何度も申し訳ないのですが、あと一歩のところまできていると思うので、お力添えよろしくお願いいたします。
ももも
（ももも） 2014/01/15(水) 22:49
>二つのチェックボックスの指定セルが同じセルになってしまい、同じ値が出てきてしまいます。 この懸念はあったのですが、取りあえず無視していました。
とりあえずキャプション（チェックボックスの文字部分）で指定する機能を追加しました。
書式は {キャプション} で、例えば
□ 項目1
のようになっていたらセル位置の部分に、{項目1} と指定してください。
併せて、複数セルを行分割するモード SEPARATE_MODE を追加。 ただこれが True の場合は複数セル指定は一列のみです。 理由は自明だと思いますので割愛。
コードは上記のものを修正しています。 （Mook） 2014/01/16(木) 00:09
残念なことに各チェックボックスのキャプションは空で、右隣のセルに別途項目が記入されています。ですのでキャプションで指定するのは無理ではないかと思いますが何か別方法がありますか？
（ももも） 2014/01/16(木) 00:18
あらら、そうなると座標かチェックボックスの名前でしょうか。
あと、上の例をよく見ると複数データの列が複数あるのですか？ それに連動するのは、もう一工夫ですね。
ちょっと対応を考えてみます。 （Mook） 2014/01/16(木) 00:22
CheckBox の指定に、コントロール名の指定を追加しました。 指定の書式は $CheckBoxName$ のように $で囲ってください。 ただ、コントロール名は EXCEL 上からは確認できないので、上記の FormCheckBoxInfo で確認してください。[]の中が名前です。 区別がつかない場合は、確認のために Caption を入れて確認してはどうかと思います。
複数データの列が複数データあった場合は、横のリンクをとらずに最大数のデータに 合わせて行をコピーし、上から詰めています。
ですので、懸念としては元データが （C3）たなかたろう （D3）2356 （C4）やましたけいこ （D4）空白 （C5）すずきいちろう （D5）8524 のような場合 １ ファイル名１ データB データC データD たなかたろう 2356 …データI ２ ファイル名１ データB データC データD やましたけいこ 8524 … データI ３ ファイル名１ データB データC データD すずきいちろう … データI のようにずれてしまいます。
このようなケースがある場合は、取りあえずデータが揃うように手で修正ください。 たくさんあるという場合は、またその時に考えましょう。 （Mook） 2014/01/16(木) 01:17
何度もすみません。
懸念されていた空白がある場合の行のずれはなく、うまく抽出できているので問題なさそうです。
問題はチェックボックスです。各ファイルのチェックボックスの数が問題になってきました。画面上はチェックボックスの数も当てはまっているセル位置もまったく同じなのですが、いくつかのファイルで上記の FormCheckBoxInfoを実行してチェックボックスの名前を調べてみると、画面上には9個しかないチェックボックスが10個や１５個あるように回答がきます。
キャプションに文字を入れて調べてみたところ、例として以下のようにInformationが帰ってきます。
file1(フォーマット上のチェックボックスと数が一致している場合）左端がキャプションにいれた画面上チェックボックスが入っているセル。これをもとに＄をつけてセル指定。
G10 [Check Box 1]....G9
G11 [Check Box 2]....G10
G12 [Check Box 3]....G12
I12 [Check Box 4]....I12
I13 [Check Box 5]....I12
G13 [Check Box 6]....G12
G19 [Check Box 7]....G19
G20 [Check Box 8]....G20
G21 [Check Box 9]....G21
file2 checkbox8がどこかに消えてる。当然G20セルにあるチェックボックスの値はNOTFOUNDとなる。
G10 [Check Box 1]....G9
G11 [Check Box 2]....G10
G12 [Check Box 3]....G12
I12 [Check Box 4]....I12
I13 [Check Box 5]....I12
G13 [Check Box 6]....G12
G19 [Check Box 7]....G19
G21 [Check Box 9]....G21
G20 [Check Box 10]....G20
file3 checkbox7,8,10,13が画面上見えず、12が消えてる。ただ、指定セルとしたCheckBox7,8は画面上見えていないのに当てはまるチェックボックスの値はNOTFOUNDとはならず、たまたまG19,G20という正しいセルが当てはまっているので正しく抽出されている。
G10 [Check Box 1]....G9
G11 [Check Box 2]....G10
G12 [Check Box 3]....G12
I12 [Check Box 4]....I12
I13 [Check Box 5]....I12
G13 [Check Box 6]....G12
[Check Box 7]....G19
[Check Box 8]....G20
G21 [Check Box 9]....G21
[Check Box 10]....G19
G20 [Check Box 11]....G20
[Check Box 13]....G19
G19 [Check Box 15]....G19
など、上記のように見えないチェックボックスに悩まされております。
やはりこうなってくるとフォーマットがばらついているということになり一括抽出は無理でしょうか。。。(涙）
何か別途ででもチェックボックスの値をセル順に取り出すみたいのはできないでしょうか。。。
ももも
（ももも） 2014/01/16(木) 23:54
同じファイルをコピーして使っていて、コントロール名が同じであればと期待したの ですが、見事にバラバラですか。
見た感じ、セルをコピー・削除しているようで、このためセルにあったチェックボックスも コピーされて重なっていたり、当初のものが消えてしまっているようです。 このため表に見えている裏にチェックボックスがあったりするような状況のようですね。
さて、どうしましょう。 （Mook） 2014/01/17(金) 00:30
おっしゃるとおりだと思います。
見た目がそろっているのでこのような問題が生じるとは思いもよりませんでした。
恐るべしチェックボックスです。。。
マクロは作れませんが、わたしも何か方法がないか考え中です。。。
多少作業工程が増えてもかまわないので、一つ一つのファイルを手作業で確認せずにチェックボックスの値をどうにか正しく取り出せればよいのですが。。難しいですね。。
（ももも） 2014/01/17(金) 17:15
なるべく汎用的なものをと考えていましたが、今回の案件に関してはこれに特化した 処理にしなければならないかもしれません。
上の3つのファイルでよいので、下記を実行した結果をコピーしてもらえるでしょうか。
Sub FormCheckBoxInfo()
Dim res(1 To 100, 1 To 30)
Dim c
Dim r
For Each r In Array("Caption", "Name", "Address", "CB Pos", "", "", "", "Cell Pos", "", "", "", "Z-order")
c = c + 1
res(1, c) = r
Next
Dim cb As checkBox
r = 2
For Each cb In ActiveSheet.CheckBoxes
res(r, 1) = cb.Caption
res(r, 2) = cb.Name
res(r, 3) = cb.TopLeftCell.AddressLocal(False, False)
res(r, 4) = cb.Top
res(r, 5) = cb.Left
res(r, 6) = cb.Width
res(r, 7) = cb.Height
res(r, 8) = cb.TopLeftCell.Top
res(r, 9) = cb.TopLeftCell.Left
res(r, 10) = cb.TopLeftCell.Width
res(r, 11) = cb.TopLeftCell.Height
res(r, 12) = cb.ZOrder
r = r + 1
Next
With Workbooks.Add().Worksheets(1)
.Range("A1").Resize(100, 30) = res
End With
End Sub
結果は新規ブックのシートに表示されるので、データ範囲をコピーしてそのまま コメントに貼り付けてもらえると良いかと思います。 （Mook） 2014/01/17(金) 20:05
以下のようになりました。キャプションをいれずにしてしまったのですが。。。（入れた場合上記のものと同じになります。）
File1
Caption Name Address CB Pos Cell Pos Z-order
Check Box 1 G9 133,5 366,75 21 16,5 117 365,25 17,25 17,25 2 Check Box 2 G10 147,75 366,75 21 17,25 134,25 365,25 17,25 15 3 Check Box 3 G12 164,25 366,75 21 16,5 164,25 365,25 17,25 15 4 Check Box 4 I12 164,25 438 21 16,5 164,25 432,75 24,75 15 5 Check Box 5 I12 178,5 438 21 16,5 164,25 432,75 24,75 15 6 Check Box 6 G12 175,5 366,75 21 22,5 164,25 365,25 17,25 15 7 Check Box 7 G19 269,25 366 21 16,5 269,25 365,25 17,25 15 8 Check Box 8 G20 284,25 366 21 16,5 284,25 365,25 17,25 15 9 Check Box 9 G21 299,25 366 21 16,5 299,25 365,25 17,25 15 10
File2
Caption Name Address CB Pos Cell Pos Z-order
Check Box 1 G9 133,5 425,25 24 16,5 117 423,75 19,5 17,25 1 Check Box 2 G10 147,75 425,25 24 17,25 134,25 423,75 19,5 15 2 Check Box 3 G12 164,25 425,25 24 16,5 164,25 423,75 19,5 15 3 Check Box 4 I12 164,25 507 24 16,5 164,25 501 28,5 15 4 Check Box 5 I12 178,5 507 24 16,5 164,25 501 28,5 15 5 Check Box 6 G12 175,5 425,25 24 22,5 164,25 423,75 19,5 15 6 Check Box 7 G19 269,25 424,5 24 16,5 269,25 423,75 19,5 15 7 Check Box 9 G21 299,25 424,5 24 16,5 299,25 423,75 19,5 15 8 Check Box 10 G20 284,25 424,5 24 16,5 284,25 423,75 19,5 15 9
File3
Caption Name Address CB Pos Cell Pos Z-order
Check Box 1 G9 133,5 589,5 24 16,5 117 588 22,5 17,25 1 Check Box 2 G10 147,75 589,5 24 17,25 134,25 588 22,5 15 2 Check Box 3 G12 164,25 589,5 24 16,5 164,25 588 22,5 15 3 Check Box 4 I12 164,25 682,5 24 16,5 164,25 676,5 32,25 15 4 Check Box 5 I12 178,5 682,5 24 16,5 164,25 676,5 32,25 15 5 Check Box 6 G12 175,5 589,5 24 22,5 164,25 588 22,5 15 6 Check Box 7 G19 269,25 588,75 24 16,5 269,25 588 22,5 15 7 Check Box 8 G20 284,25 588,75 24 16,5 284,25 588 22,5 15 8 Check Box 9 G21 299,25 588,75 24 16,5 299,25 588 22,5 15 9 Check Box 10 G19 269,25 588,75 24 16,5 269,25 588 22,5 15 10 Check Box 11 G20 284,25 588,75 24 16,5 284,25 588 22,5 15 11 Check Box 13 G19 269,25 588,75 24 16,5 269,25 588 22,5 15 12 Check Box 15 G19 269,25 588,75 24 16,5 269,25 588 22,5 15 13
どうでしょうか。。。
ももも
（ももも） 2014/01/17(金) 21:37
データの提示ありがとうございます。
これをもとに対策を考えて見ます。 しばしお待ちを。 （Mook） 2014/01/17(金) 21:52
本当に何度も何度もお手数をおかけして申し訳ありません。
どうぞよろしくお願いいたします。
（ももも） 2014/01/17(金) 23:41
とりあえず、チェックボックスの大きさとセルの大きさがほぼ同じくらいのようなので チェックボックスのセンター位置でセルを指定するようにしました。
最初にテストしてもらった、Caption のセルに変更してください。 >I13 [Check Box 5]....I12 となっている部分は、[I13] でとれるようになると思います。 （指定は当初の[セル位置] だけにしました。）
同じセルに複数ある場合は、最前面のチェックボックスの値をとるように変更しています。 これで試してみてもらえるでしょうか。
In bocca al lupo!
'----------------------------------------------------------------------------- Option Explicit
'// Option Definition
'// 1) Make File Link '//---------------- Public Const MAKE_LINK = True
'// 2) Separate Multiple Cell Data '//---------------- Public Const SEPARATE_MODE = True
'// Multiple data delimiter '// Available in [SEPARATE_MODE = False] Public Const DELIMITER = vbLf ' // 区切り文字指定 : セル内改行 'public Const DELIMITER = ","
'-----------------------------
Sub MakeDataList()
'-----------------------------
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim dataWS As Worksheet
Set dataWS = ActiveSheet
Dim folderPath
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> True Then Exit Sub
folderPath = .SelectedItems(1)
End With
Dim dstRow As Long
Dim dstCol As Long
Dim lastCol As Long
dstRow = dataWS.Cells(Rows.Count, "A").End(xlUp).row + 1
If dstRow < 3 Then dstRow = 3
lastCol = dataWS.Range("B2").End(xlToRight).Column
If lastCol = Columns.Count Then
MsgBox "Data definition is not valid"
Exit Sub
End If
Dim file
Dim mData
Dim i As Long
Dim dataNum As Long
Dim multipleDataMax As Long
Dim colDic
Set colDic = CreateObject("Scripting.Dictionary")
Dim colKey
'// Check multiple data column
For dstCol = 2 To lastCol
If InStr("{[$", Left(dataWS.Cells(2, dstCol).Value, 1)) = 0 Then
If Range(dataWS.Cells(2, dstCol).Value).Cells.Count > 1 Then
colDic(dstCol) = dataNum
End If
End If
Next
For Each file In fso.GetFolder(folderPath).Files
If dataWS.Columns("A:A").Find(file.Name, LookAt:=xlWhole) Is Nothing Then
With Workbooks.Open(folderPath & "\" & file.Name)
If MAKE_LINK = True Then
dataWS.Hyperlinks.add Anchor:=dataWS.Cells(dstRow, "A"), _
SubAddress:=.Worksheets(1).Name & "!A1", _
Address:=folderPath & "\" & file.Name, _
TextToDisplay:=file.Name
Else
dataWS.Cells(dstRow, "A").Value = file.Name
End If
multipleDataMax = 0
For dstCol = 2 To lastCol
dataWS.Cells(dstRow, dstCol).Value = getDataFromWS(.Worksheets(1), dataWS.Cells(2, dstCol).Value, dataNum)
If dataNum > multipleDataMax Then multipleDataMax = dataNum
Next
.Close savechanges:=False
'// Multi Data Column Processing
If SEPARATE_MODE = True And multipleDataMax > 1 Then
For i = 1 To multipleDataMax - 1
dataWS.Rows(dstRow).Copy dataWS.Rows(dstRow + i)
Next
For Each colKey In colDic.keys
mData = Split(dataWS.Cells(dstRow, colKey).Value & Application.Rept(DELIMITER, multipleDataMax), DELIMITER)
For i = 0 To multipleDataMax - 1
dataWS.Cells(dstRow + i, colKey).Value = mData(i)
Next
Next
dstRow = dstRow + multipleDataMax
Else
dstRow = dstRow + 1
End If
End With
End If
Next
End Sub
'-----------------------------
Function getDataFromWS(ws As Worksheet, srcAddr As String, ByRef dataNum As Long)
'-----------------------------
Dim cellAddr As String
Dim cbCaption As String
Dim cbName As String
Dim dc As Range
Select Case True
Case InStr(srcAddr, "[") = 1
cellAddr = Replace(Replace(srcAddr, "[", ""), "]", "")
getDataFromWS = _
getFormCheckBoxCenterPosInCell(ws.Range(cellAddr))
Case Else
getDataFromWS = ""
dataNum = 0
For Each dc In ws.Range(srcAddr)
If dc.Value <> "" Then
getDataFromWS = getDataFromWS & IIf(dataNum > 0, DELIMITER, "") & dc.Value
dataNum = dataNum + 1
End If
Next
End Select
End Function
'-----------------------------
Function getFormCheckBoxCenterPosInCell(cbCell As Range)
'-----------------------------
Dim cpx As Double
Dim cpy As Double
Dim zorder As Long
zorder = -1
getFormCheckBoxCenterPosInCell = "Not Found"
Dim cb As CheckBox
For Each cb In cbCell.Parent.CheckBoxes
cpx = cb.Left + cb.Width / 2
cpy = cb.Top + cb.Height / 2
If cpx > cbCell.Left And cpx < (cbCell.Left + cbCell.Width) _
And cpy > cbCell.Top And cpy < (cbCell.Top + cbCell.Height) Then
If cb.zorder > zorder Then
getFormCheckBoxCenterPosInCell = IIf(cb.Value > 0, True, False)
zorder = cb.zorder
End If
End If
Next
End Function
（Mook） 2014/01/18(土) 00:09
ありがとうございます！
手元にデータを持ち帰って来ていないので、来週月曜日に上記のコードで試してみます。
こんなに長いものを作るのは大変だったのではないでしょうか。
本当に感謝のしようがありません。ありがとうございます。
試した結果をまたすぐUPさせていただきます。よろしくお願いいたします。
Crepi!!
ももも
（ももも） 2014/01/18(土) 03:23
今回の問題は面白そうだったので、いろいろと考えてみました。
元があったので、都度の変更はそれほど大変な量ではありませんし、 こういうときの試行錯誤は何かのときに、「あっ、そういえば あのときのやり方が！」と 自分でも役立つことが多いです。
おまけですが、元ファイルを確認しやすいように、ハイパーリンクオプションを追加しました。
今回はイタリアにお住まいの方とやり取りということで、イタリア語を懐かしく 思い出せたのも楽しかったです（もう、ほとんど忘れてしまっていましたが）。
おまけですが、データの数値の小数点が「.」ではなく「,」なのを見て、こんなところが イタリアだなぁ、と変なところに感心しましたｗ。
Buon week end! （Mook） 2014/01/18(土) 12:09
できました！！！！すごい！！！
実際の7ファイルを使って試しているのですが、チェックボックスとの整合性も7ファイル全てあけて目で確認し、全てあってました！！
感動です！
これはもう魔法の域ですね。。。。
こちらのマクロを使って他のファイルも一緒に試してみます。（今日はその作業はできそうにないのですが。）おそらくまた何かしらイレギュラーなファイルがちょこちょこありそうな気もしますが、ないことを祈って。。。
イタリアにお住まいだったことがあるのですか？
わたしはまだ来て2年ほどで、イタリア語もペーペーです。
イタリア語でエクセルを使うのも初めてで、関数の区切り文字も ,ではなく ; だったり、関数名もSUMでは計算してくれず、SOMMAといれないといけなかったり。。。なぜ関数名が英語対応していないのか意味不明です。
なにはともあれ、本当にありがとうございます！！
ももも
（ももも） 2014/01/20(月) 17:43
何はともあれ動いたようで何よりです。
イタリア人の知人がいたのと、観光で行っただけで、残念ながら住んだことはありません。 旅行に行く前後に、二年ほど勉強しましたが、なんとか買い物や挨拶ができる程度で 日常会話には程遠いです^^;;。
マクロは初めてとの事ですが、 せっかくの機会ですから、これから使い始めて、使える場面を増やしていけるとよいかと 思います。
EXCELのマクロは全国共通のようですから、覚えておけばどこの国でも使えますよｗ。
それでは、 Ciao！ （Mook） 2014/01/20(月) 19:51
お久しぶりです。
前回の抽出ファイルに引き続いての質問です。かなり表題からずれてしまって申し訳ないのですが。。一応続いている作業なのでこちらに書き込みました。
作っていただいたマクロでデータを抽出した後、こんなことができないかと考えています。AccessやFileMakerも考えたのですが、とりあえずいまのところわたしのPCにこれらが入っていないので、もしやExcelだけでできるのであればと淡い期待をもって質問させていただきます。
やりたいのは前回したことと逆のことで、データを取り出した抽出ファイルから別のフォーマットにデータを書き出すというのをしたいのです。
理想は、抽出ファイルにさらに必要なデータをくっつけて（これは自分できそう）で、そこから必要な行（ファイル）だけ選択して、別ファイルのフォーマットに書き出す。書き出したいフォーマットが2種あるのでできれば２つボタン作ってそれぞれクリックしたら別ブックが開いて自動入力というようなことです。で、この新しいブックは指定フォルダに保存。書き出したいフォーマットは現在Wordを使用しているのですが、エクセルに変更も可です。
前回までは、これまでの過去のものをデータ化するために300ファイルほどまとめての抽出方法をうかがいました。これまでは上記の別フォーマットに書き出すのもコピペでしていたのですが、これから増えるデータに関しては、抽出ファイルにまとめると同時にワンクリックでフォーマットに書き出せればと考えています。
と、漠然とした質問で申し訳ないのですが、Excel上だけでこのようなことはできるでしょうか？
これだったらアクセスのほうがとかFilemakerのほうがといったアドバイスでもかまいません。
よろしくお願いいたします。
ももも
（ももも） 2014/01/23(木) 23:47
まずはデータをテーブルにまとめれば、それをマスタとしてデータを２次利用するという のは当然な運用ですし、そのためのマスタデータ作りだと思います。
そのマスタデータを Access にしたり、Excel にしたり、大容量になればデータベースを 導入したりと、そこはケース バイ ケース だと思いますが、300（数千くらいまでは） 程度のデータであれば EXCEL で十分だと思います。
いろいろなフォーマットへの出力も可能だと思いますが、Word へ個別レコードを当て はめて出力したいというような向きには、「流し込み印刷」などのキーワードで探して みるといろいろ見つかると思います。
当初の話だと、Access に取り込む（？）だったと思いますが、その場合は出力フォーム の作成で対応できるでしょうか。
まずは、もうすこし具体的にやりたいことを説明してはと思います。
ただ質問の内容が変わっているので、今回の質問をリンクとして記載し、新規で立てても よいように思います。
（Mook） 2014/01/24(金) 12:21
貴重なアドバイスありがとうございます。
「流し込み印刷」というのも知らない言葉だったので、そちらで検索してみて試してから別途質問たてたいと思います。
当初はアクセスでと思っていたのでが、手元のPCにアクセスが入っていないのでいろいろ試すことができないのと、最終的にこの作業をするのが私だけではないのでエクセルで対応可能ならエクセルで全部してしまったほうがシンプルにすむかなと考えて模索中です。
とにもかくにもありがとうございます。
Grazie tanto!!
ももも
（ももも） 2014/01/24(金) 16:44
Prego,
うろ覚えで書いてしまいましたが、 「流し込み印刷」より「差込印刷」の方が一般的な言葉だったようです。 検索の際はそちらも参照ください。
学校の過去の質問でもよく話題に上がっていましたので、そちらも参考にされると 良いかと思います。 http://www.excel.studio-kazu.jp/cgi-bin/estindex/estseek2.cgi?phrase=%E5%B7%AE%E3%81%97%E8%BE%BC%E3%81%BF%E5%8D%B0%E5%88%B7 （Mook） 2014/01/24(金) 16:57
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.