[[20140109021929]] 『複数ファイル内の同一セルデータを別ファイルに一』(ももも) >>BOT

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

 

『複数ファイル内の同一セルデータを別ファイルに一覧にしたい』(ももも)

マクロ、VBEなど聞いたことはありますが全く使ったことがありません。
職場でのデータ作成のために以下のことをしたいと考えています。

状況
フォルダ内に300程のエクセルファイルが存在。
各エクセルファイルに同一フォーマットでデータが記入されており、同じセルに同じ項目のデータが入っている。


ファイル1
(A,1)住所   (B,1)TEL (C,7)郵便番号  (D,4)プロジェクト名

  (A,2)東京都        (B,2)03-888-3333     (C,8)999-6666   (D,5)ABCproject
ファイル2 
 (A,1)住所   (B,1)TEL                     (C,7)郵便番号  (D,4)プロジェクト名
  (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

Mook様

過去質をみて、試しに2つの以下のようなエクセルファイルを作ってそれを別ファイルにデータ抽出するようにしてみたかったのですがうまくできませんでしたので教えてください。

私がしたこと>
1、エクセルファイルにデータの値は適当に変えて以下のように入力し2つサンプルファイルを作成(各「カルタ1」「カルタ2」とします、シート名はどちらもSheet1のまま)
  A   B      C   D
1  住所  郵便番号   名前  電話番号
2 東京  000-5555  山田  000-5888
3

2、別のファイル(「抽出ファイル」とします)に過去質問の回答にあったように入れたいセルの位置を入力
  A   B     C    D
1  住所  郵便番号 名前  電話番号
2 A2   B2   C2    D2
3

2のファイルを開いている状態でAlt+F11でVBEを開き、挿入、モジュールを選択し、コードをそのままコピペ、Alt+F11でExcelに戻る(他はいっさい触ってません)

Alt+F8でMakeDataListを実行(MakeDateListと出ていたので何も変更せずにそのまま実行をしました)

すると、フォルダを選択するような画面が出たので上記の2つのサンプルファイルと抽出ファイルの入っているフォルダを選択し、OKを押しました。(しかし、画面上には対象になるファイルがないというような文字が出ていて、上記の3ファイルが見えない状態でした。が、よくわからなかったのでそのままOKにしました。

結果、A列にファイル名"カルタ1.xlsx."、"カルタ2.xlsx."が入り、B,C,D列は正しく入っている状態でした。
しかし別ウィンドウが開きそこに、「このファイルはすでに開かれています。再び開くと実行された操作が消去されるおそれがあります。開きますか?といった内容の忠告が出ます。そのまま開くと忠告どおり、抽出されたデータが消え、NOとするとVBE画面が開き、RUNTIme1004エラー 「手順「Workbookを開く」が実行できませんでした。という内容の文字が出ます。その下にFineとDebugと出で、Debugを選択するとコード内のWith Workbooks.Open(folderPath & "\" & file.Name)の部分が黄色く反転します。

以下質問
1、VBEを開くのは抽出ファイルを開いた状態で、カルタ1カルタ2は閉じた状態でしましたがあっていますか?(実際にしたい作業のファイルは300ほどあるので全部開いての作業は無理だと思って閉じてしました。)
2、A列にデータが入らないのはどうすればなおりますか?コードを何か変更したり追加したりしないといけないのでしょうか?
3、フォルダを選択する際フォルダを選択すると中身が入ってないような画面になるのですがそれであっているのでしょうか?
4、コード内のMsgBox "取得位置が範囲が未定義です "の部分がVBEにコピペすると "????????"となります。言語設定が日本語でないとこうなるのでしょうか?イタリア語でのExcelを使用しています。
5、VBEの実行をした後に出てくる忠告内容に対してどう進めればよいのでしょうか。?忠告内容はイタリア語で出てきたのを日本語に訳しています。
本当にど素人なので、質問内容が意味不明かもしれませんが、できるだけ詳細に全てのステップを教えていただけるとありがたいです。

お手数おかけしますがよろしくお願いします。
(ももも) 2014/01/10(金) 02:02


 遅い時間でのアクセスだと思いましたが、
 Buon giorno
 のお国でしょうか。

 それはさておき、
 マクロを実行する手順は正しいです。
 実行時の選択はフォルダを選択するので、ファイルは見えていません。

 おそらく、マクロを書いたファイル(2)とデータが同じフォルダにあるのではない
 でしょうか。

 実行するマクロはデータフォルダとは別の想定だったので、一緒の場合そのような
 動作になってしまうと思います。

 最後の部分を
    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 ファイルが開いていない状態で実行するのが混乱ないと思います。

 2は、A列はどのファイルからデータをとってきたかわかるようにファイル名にして
 いるので、データ列はB列からにして、不要であれば収集後にA列を削除してください。

 4に関しては VBE は UNICODE 対応していないので、Windows の言語設定が日本語で
 ない場合 VBE 内では日本語を記述できません。
 ですのでメッセージは ‘La posizione di dati è indefinita' のように(自信なし)
 変更してください。

 不明な点は再度コメントください。

 Ciao!
(Mook) 2014/01/10(金) 07:53

Mook様

おっしゃるとおりイタリアから質問させていただいてます。
なかなか詳しい情報が見つけられず、こちらにたどり着いた次第です。

うまくデータを取り出すことができました!感動!すごいですね!!!

追加で2点質問させてください!

1、前回のレスでMsgBox "取得位置が範囲が未定義です "の部分の文字変更する話が出ましたが、変更してもしなくても結果は同じようになりました。この部分はどういう指示がなされているコードなのでしょうか?何らかの場合にこのメッセージがセルに記入されるとかですか?

2、最後の保存の方法はどうしたらいいのでしょうか?

マクロを残して保存するには保存ファイルの種類を選ばないといけないと出るのですが、どれを選べばいいのでしょうか?
それともマクロを残さずに保存するにしたほうがいいのでしょうか?
マクロを残して保存する場合と残さずに保存する場合のメリットデメリットがよくわかりません。
マクロを残して保存すれば今後、同フォーマットであれば、他のフォルダのファイルからも抽出できるということでしょうか?この場合前回に抽出したデータの最終行の下に追加されていくのでしょうか?

重ね重ね申し訳ありませんが、もう少しお付き合いいただければ大変ありがたいです。
よろしくお願いいたします。

(ももも) 2014/01/10(金) 18:31


 Buona sera,
 イタリアにお住まいとは羨ましいです。
 名所が多くて、食べ物もおいしそうという印象ですが、お仕事はやはり大変ですよね。

 まずはうまくいったようで何よりです。

 1、MsgBox はシートの参照の定義がうまくできていないときのものなので、うまく収集
 できる場合は実行されません。ので無くとも動作には影響しません。

 2、保存ファイルにマクロはあっても無くてもいいですが、作成したデータの運用には
 必要ありませんのでマクロを削除するか、シートを別のファイルにコピーして保存すれば
 いいと思います。

 再実行した場合は指定フォルダを再検索して3行目から上書きしてしまうので、追記は
 できません。

 今後もデータを追加していくような運用の場合は、マクロをを見直す必要がありますので、
 その際は別途やりたい内容を説明されてはと思います。

 Arrivederci
(Mook) 2014/01/10(金) 22:31

Mook様

おかげさまでやりたいと思っていたファイルの作成ができそうな感じです。試しに実際の幾つかのファイルを使って実行してみました。

実際にやってみてあらたに気づいた問題点が2点あります。お知恵を拝借できますでしょうか。

1、各ファイル内のフォーマットの中にチェックボックスにチェックを入れて選択する部分が数カ所ある。
  チェックボックスはエクセルの開発タブに入ってる標準のもので、チェックボックスとチェック項目はセルが別れています。
  他の項目と同じようにセル指定をして抽出してみましたが、当然ですが何も抽出されませんでした。
  
2、一項目にデータ内容が2つ以上ある項目が数カ所ある。
  実務者を入力している項目で、1項目に対して2人、または3人(全ファイルを確認していないのでそれ以上の場合もあるかも。。。)。抽出する際一つのファイルから一項目に対して2つ以上のデータを縦に並べるというのは想定していないコードと理解しましたので、今回は横に並べて2人まで抽出しました。

理想
1、チェックボックスにチェックが入っている場合は1、入っていない場合は0(あるいはTrue/Forse)など、データが入るようにしたい。他のデータ抽出と同時にこれができれば理想だが、無理ならば、まず先にチェックボックスのチェックを別ファイルにファイル名と1/0(True/Forse)などに置き換えて抽出したい。

2、実務者の人数が増えても書き出せるようにしたい。
  

      ファイル名1 データA  データB データC データD データE 実務者あ 実務者あコード データ H データI
  ファイル名1 データA  データB データC データD データE 実務者い 実務者いコード データ H データI
  ファイル名2 データAA  データBB データCC データDD データEE 実務者か 実務者かコード データ HH データII
  ファイル名2 データAA データBB データCC データDD データEE 実務者き 実務者きコード データ HH データII
  ファイル名2 データAA データBB データCC データDD データEE 実務者く 実務者くコード データ HH データII

  上のように各実務者に対して他のデータが重複して存在するような感じになれば ありがたいです。
これも他の抽出と一緒にできれば良いのですが、無理ならば、別ファイルにファイル名と実務者関係の項目だけ書き出して後でくっつける形でもかまいません。

わかりにくかったら申し訳ありません。
どうぞよろしくお願いいたします。

(ももも) 2014/01/14(火) 03:39


 チェックボックスは開発⇒挿入の中の上段(フォームコントロール)と
 下段(ActiveX コントロール)とどちらでしょうか。

 2に関しては、今回 Access に登録するためのデータをまとめるということだったと
 思いますが、複数データを1項目にしたいのでしょうか、それとも個別に登録したい
 のでしょうか。

 それによって、データの集め方も異なってくると思います。
(Mook) 2014/01/15(水) 00:57

Mook様

早速回答いただきありがとうございます。

1、チェックボックスはフォームコントロールの方です。

2、すみません。複数データを一項目にというのと、個別に登録というのが違いがわかりません。簡単な例を挙げていただけないでしょうか?

よろしくお願いいたします。

ももも

(ももも) 2014/01/15(水) 02:55


 とりあえず2に関して。
 アクセス側の実務者を入力する欄が、実務者1、実務者2、実務者3と複数あるのか、
 実務者という一つの欄に、"実務者1、実務者2、実務者3" というに複数のデータを
 一箇所に登録するのかということです。

 1に関してはチェックボックスの読込指定を入れればよいと思いますがコントロールの
 種類によってやり方が異なるので、確認しました。
 マクロの変更は後ほど。
(Mook) 2014/01/15(水) 07:52

Mook様

2に関して、おっしゃっていただいた後者の方「実務者という一つの欄に、"実務者1、実務者2、実務者3" というに複数のデータを

 一箇所に登録する」です。 うまく説明できず申し訳ありません。

あと、もう一点質問です。
フォーマット上でデータが入っているセルが結合セルの場合どのようにセル指定をするのが正しいでしょうか?
試しにしてみたときは、G20・H20のセルが結合しているセルにデータが入っていて、そこのセル指定はG20として抽出をしたところ正しく抽出されているようでした。やり方としては結合セルの場合、最左列上行のセルを指定セルにすればよいのでしょうか?(実際のフォーマットには列の結合はあっても行の結合はないですが)

よろしくお願いいたします。
(ももも) 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様

ありがとうございます!
データの追加までできるようになるなんて最高です!!

わたしのあたまがMook様の神業に追いつかないので教えてください!!

・フォームコントロールのチェックボックス 値の取得機能を追加

   例)[B3] のようにチェックボックスの左上のセルを[ ]で囲んで指定
  左上セルは文字や□ では無く、オブジェクトの位置ですので開発のデザインモードで
  チェックボックスを選択し、破線の左上のセルを指定してください。

の部分が理解できませんでした。

1、たとえばチェックボックスがフォーマットのG20セルに位置している場合、左上のセル=F19が指定アドレスとなり、抽出先のファイルには[F19]と入力するということでしょうか?それとも[G20]がただしいですか?

2、左上セルは文字や□ では無く、オブジェクトの位置ですので開発のデザインモードで
チェックボックスを選択し、破線の左上のセルを指定してください。 とのことですが、この部分がまったくわかりません。抽出ファイル(マクロを貼る方)を開いて、そこで開発のデザインモードですか?破線とはどこのことでしょうか。。。

お手数おかけして本当に申し訳ありません。もう少し詳しく教えてください。
よろしくお願いいたします。

ももも

(ももも) 2014/01/15(水) 19:39


 参照先は ActiveX コントロールの例ですけれど、
http://www4.synapse.ne.jp/yone/excel2010/excel2010_x_checkbox.html

 のような感じです(「チェックボックスをシートに配置する」の2の絵だと
 おそらく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


Mook様

チェックボックスのところわかりました!ありがとうございます!!

チェックボックスのセル位置を確認してみることができたのですが、一部セルがダブってしまっているところがあります。二つのチェックボックスの指定セルが同じセルになってしまい、同じ値が出てきてしまいます。これはどうにかできるでしょうか?

あと、・セルのアドレス記述を複数アドレス記述できるように変更。

   例) C3:C5   C3:E3    C3,C5,C7  など

なのですが、実際に範囲を入れて抽出してみたところ、たとえば実務者名前という項目に対して元のフォーマットではC3,C4,C5に各名前が入っているのを抽出した先では、C3,C4,C5 の名前がくっついて一つのセルに入ります。

フォーマットで下記のようになっているのを、

ファイル1
  (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     …
1 ファイル名1 データB データC  データD たなかたろう 2356 …データI
2 ファイル名1 データB データC  データD やましたけいこ 6621 … データI
3 ファイル名1 データB データC  データD すずきいちろう 8524 … データI
4 ファイル名2 データBB データCC データDD やまだはなこ 5524 … データII
5 ファイル名2 データBB データCC データDD なかたひでこ 7745 … データII
6 ファイル名3 。。。。。。。。

もしかしたら前回おっしゃっていただいた前者のほうに当たっているかもしれません。読解力がなく申し訳ありません。
理想は各実務者名からもその他のデータをつなげられるようにしたいので、名前が一つのセルにまとまるとやりにくくなります。

本当に何度も申し訳ないのですが、あと一歩のところまできていると思うので、お力添えよろしくお願いいたします。

ももも
(ももも) 2014/01/15(水) 22:49


 >二つのチェックボックスの指定セルが同じセルになってしまい、同じ値が出てきてしまいます。
 この懸念はあったのですが、取りあえず無視していました。

 とりあえずキャプション(チェックボックスの文字部分)で指定する機能を追加しました。
 書式は {キャプション} で、例えば
   □ 項目1
 のようになっていたらセル位置の部分に、{項目1} と指定してください。

 併せて、複数セルを行分割するモード SEPARATE_MODE を追加。
 ただこれが True の場合は複数セル指定は一列のみです。
 理由は自明だと思いますので割愛。

 コードは上記のものを修正しています。 
(Mook) 2014/01/16(木) 00:09

Mook様

残念なことに各チェックボックスのキャプションは空で、右隣のセルに別途項目が記入されています。ですのでキャプションで指定するのは無理ではないかと思いますが何か別方法がありますか?
(ももも) 2014/01/16(木) 00:18


 あらら、そうなると座標かチェックボックスの名前でしょうか。

 あと、上の例をよく見ると複数データの列が複数あるのですか?
 それに連動するのは、もう一工夫ですね。

 ちょっと対応を考えてみます。
(Mook) 2014/01/16(木) 00:22

 CheckBox の指定に、コントロール名の指定を追加しました。
 指定の書式は $CheckBoxName$ のように $で囲ってください。
 ただ、コントロール名は EXCEL 上からは確認できないので、上記の FormCheckBoxInfo
 で確認してください。[]の中が名前です。
 区別がつかない場合は、確認のために Caption を入れて確認してはどうかと思います。

 複数データの列が複数データあった場合は、横のリンクをとらずに最大数のデータに
 合わせて行をコピーし、上から詰めています。

 ですので、懸念としては元データが
  (C3)たなかたろう     (D3)2356
  (C4)やましたけいこ    (D4)空白
  (C5)すずきいちろう    (D5)8524 
 のような場合
1 ファイル名1 データB データC  データD たなかたろう 2356 …データI
2 ファイル名1 データB データC  データD やましたけいこ 8524 … データI
3 ファイル名1 データB データC  データD すずきいちろう    … データI 
 のようにずれてしまいます。

 このようなケースがある場合は、取りあえずデータが揃うように手で修正ください。
 たくさんあるという場合は、またその時に考えましょう。
(Mook) 2014/01/16(木) 01:17

Mook様

何度もすみません。

懸念されていた空白がある場合の行のずれはなく、うまく抽出できているので問題なさそうです。

問題はチェックボックスです。各ファイルのチェックボックスの数が問題になってきました。画面上はチェックボックスの数も当てはまっているセル位置もまったく同じなのですが、いくつかのファイルで上記の FormCheckBoxInfoを実行してチェックボックスの名前を調べてみると、画面上には9個しかないチェックボックスが10個や15個あるように回答がきます。
キャプションに文字を入れて調べてみたところ、例として以下のように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

Mook様

おっしゃるとおりだと思います。

見た目がそろっているのでこのような問題が生じるとは思いもよりませんでした。
恐るべしチェックボックスです。。。

マクロは作れませんが、わたしも何か方法がないか考え中です。。。
多少作業工程が増えてもかまわないので、一つ一つのファイルを手作業で確認せずにチェックボックスの値をどうにか正しく取り出せればよいのですが。。難しいですね。。

(ももも) 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

Mook様

以下のようになりました。キャプションをいれずにしてしまったのですが。。。(入れた場合上記のものと同じになります。)

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

Mook様

本当に何度も何度もお手数をおかけして申し訳ありません。
どうぞよろしくお願いいたします。
(ももも) 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


Mook様

ありがとうございます!

手元にデータを持ち帰って来ていないので、来週月曜日に上記のコードで試してみます。
こんなに長いものを作るのは大変だったのではないでしょうか。
本当に感謝のしようがありません。ありがとうございます。

試した結果をまたすぐUPさせていただきます。よろしくお願いいたします。

Crepi!!

ももも
(ももも) 2014/01/18(土) 03:23


 今回の問題は面白そうだったので、いろいろと考えてみました。

 元があったので、都度の変更はそれほど大変な量ではありませんし、
 こういうときの試行錯誤は何かのときに、「あっ、そういえば あのときのやり方が!」と
 自分でも役立つことが多いです。

 おまけですが、元ファイルを確認しやすいように、ハイパーリンクオプションを追加しました。

 今回はイタリアにお住まいの方とやり取りということで、イタリア語を懐かしく
 思い出せたのも楽しかったです(もう、ほとんど忘れてしまっていましたが)。

 おまけですが、データの数値の小数点が「.」ではなく「,」なのを見て、こんなところが
 イタリアだなぁ、と変なところに感心しましたw。

 Buon week end!
(Mook) 2014/01/18(土) 12:09

Mook様

できました!!!!すごい!!!
実際の7ファイルを使って試しているのですが、チェックボックスとの整合性も7ファイル全てあけて目で確認し、全てあってました!!
感動です!
これはもう魔法の域ですね。。。。

こちらのマクロを使って他のファイルも一緒に試してみます。(今日はその作業はできそうにないのですが。)おそらくまた何かしらイレギュラーなファイルがちょこちょこありそうな気もしますが、ないことを祈って。。。

イタリアにお住まいだったことがあるのですか?
わたしはまだ来て2年ほどで、イタリア語もペーペーです。
イタリア語でエクセルを使うのも初めてで、関数の区切り文字も ,ではなく ; だったり、関数名もSUMでは計算してくれず、SOMMAといれないといけなかったり。。。なぜ関数名が英語対応していないのか意味不明です。

なにはともあれ、本当にありがとうございます!!

ももも

(ももも) 2014/01/20(月) 17:43


 何はともあれ動いたようで何よりです。

 イタリア人の知人がいたのと、観光で行っただけで、残念ながら住んだことはありません。
 旅行に行く前後に、二年ほど勉強しましたが、なんとか買い物や挨拶ができる程度で
 日常会話には程遠いです^^;;。

 マクロは初めてとの事ですが、
 せっかくの機会ですから、これから使い始めて、使える場面を増やしていけるとよいかと
 思います。

 EXCELのマクロは全国共通のようですから、覚えておけばどこの国でも使えますよw。 

 それでは、
 Ciao!
(Mook) 2014/01/20(月) 19:51

Mook様

お久しぶりです。

前回の抽出ファイルに引き続いての質問です。かなり表題からずれてしまって申し訳ないのですが。。一応続いている作業なのでこちらに書き込みました。
作っていただいたマクロでデータを抽出した後、こんなことができないかと考えています。AccessやFileMakerも考えたのですが、とりあえずいまのところわたしのPCにこれらが入っていないので、もしやExcelだけでできるのであればと淡い期待をもって質問させていただきます。

やりたいのは前回したことと逆のことで、データを取り出した抽出ファイルから別のフォーマットにデータを書き出すというのをしたいのです。

理想は、抽出ファイルにさらに必要なデータをくっつけて(これは自分できそう)で、そこから必要な行(ファイル)だけ選択して、別ファイルのフォーマットに書き出す。書き出したいフォーマットが2種あるのでできれば2つボタン作ってそれぞれクリックしたら別ブックが開いて自動入力というようなことです。で、この新しいブックは指定フォルダに保存。書き出したいフォーマットは現在Wordを使用しているのですが、エクセルに変更も可です。

前回までは、これまでの過去のものをデータ化するために300ファイルほどまとめての抽出方法をうかがいました。これまでは上記の別フォーマットに書き出すのもコピペでしていたのですが、これから増えるデータに関しては、抽出ファイルにまとめると同時にワンクリックでフォーマットに書き出せればと考えています。

と、漠然とした質問で申し訳ないのですが、Excel上だけでこのようなことはできるでしょうか?

これだったらアクセスのほうがとかFilemakerのほうがといったアドバイスでもかまいません。

よろしくお願いいたします。

ももも
(ももも) 2014/01/23(木) 23:47


 まずはデータをテーブルにまとめれば、それをマスタとしてデータを2次利用するという
 のは当然な運用ですし、そのためのマスタデータ作りだと思います。

 そのマスタデータを Access にしたり、Excel にしたり、大容量になればデータベースを
 導入したりと、そこはケース バイ ケース だと思いますが、300(数千くらいまでは)
 程度のデータであれば EXCEL で十分だと思います。

 いろいろなフォーマットへの出力も可能だと思いますが、Word へ個別レコードを当て
 はめて出力したいというような向きには、「流し込み印刷」などのキーワードで探して
 みるといろいろ見つかると思います。

 当初の話だと、Access に取り込む(?)だったと思いますが、その場合は出力フォーム
 の作成で対応できるでしょうか。

 まずは、もうすこし具体的にやりたいことを説明してはと思います。

 ただ質問の内容が変わっているので、今回の質問をリンクとして記載し、新規で立てても
 よいように思います。

(Mook) 2014/01/24(金) 12:21


Mook様

貴重なアドバイスありがとうございます。

「流し込み印刷」というのも知らない言葉だったので、そちらで検索してみて試してから別途質問たてたいと思います。

当初はアクセスでと思っていたのでが、手元の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.