PR
古庄 潤(ふるしょう じゅん)
本業はエンジニア。ICに様々な機械をつなぎ,電流やら電圧を測定する。もちろん,これらの測定器もVBAでコントロールし,取り込んだデータもマクロで処理する。人呼んで,マクロの鬼軍曹!
今回のサンプルは,Excel 2002/2003/2007での動作を確認しています

ザクザク・・・ザクザク
「先生,何してるんですか?」
「おぉ,ゲール君。青唐辛子を刻んでおるんじゃよ」
「青唐辛子?あの,庭に生えている?」
「生えているんじゃない。植えておるんじゃ」
「どっちでもいいです。で,それを刻んでどうするんですか?」
「塩漬けにするんじゃ」
「何故に?」
「それは,冬でも青唐辛子の風味を味わえるようにじゃ」
「保存食ですか?」
「まぁ,そのようなものじゃ」
「だったら,干せばいいのに」
「干したら,風味がなくなる」
「どういうこと?」
「青唐辛子には,独特の香りがあるんじゃ。わしは,それが好きで,青唐辛子を素麺やざるうどんの薬味に使うんじゃ」
「へぇ~,確か去年はかぼすでしたよね?」
「そう!かぼすの皮を下ろし金で摩り下ろすと,いい匂いの薬味になる」
「飽きちゃったんですか?」
「マイブームというやつじゃ」
「飽きちゃったんですね」
「時代の流れというものじゃよ」
「いつか,わたしにも飽きちゃうのかなぁ?」
「え?」
「お待ちの患者さん,ど~ぞ~」

今月の相談
 ホームページで募集したアンケートの集計をしています。アンケートは個別のテキストファイルに落ちるので,それをExcelファイルにして,必要なデータだけを別のExcelファイルに抽出しています。この時GetOpenFilenameメソッドのMultiSelectオプションをTrueにして,複数のファイルをまとめて処理していますが,ファイルの数が多いので,[ファイルを開く]ダイアログボックスでファイルを選択するのが結構手間です。選び損ねるミスも時々あります。何かいいアイデアはないでしょうか?

リスト1●アンケートを集計するプログラム
Sub Aggregation()
    Dim myFile_Name As Variant
    Dim i As Integer
    Dim j As Integer
    Dim myRow As Long
    Dim myD_Book As Workbook
    Dim myD_Sheet As Worksheet
    Dim mySummary_Sheet As Worksheet

    myFile_Name = Application.GetOpenFilename _
            ("Excel ファイル (*.xls), *.xls", MultiSelect:=True)

    If IsArray(myFile_Name) = False Then
        Exit Sub
    End If

    Set mySummary_Sheet = ThisWorkbook.Worksheets(1)
    myRow = mySummary_Sheet.Cells(Rows.Count, 2).End(xlUp).Row

    For i = LBound(myFile_Name) To UBound(myFile_Name)
        myRow = myRow + 1

        Set myD_Book = Workbooks.Open(myFile_Name(i))
        Set myD_Sheet = myD_Book.Worksheets(1)

        For j = 0 To 3
            mySummary_Sheet.Cells(myRow, 2 + j).Value = myD_Sheet.Cells(3 + j, 3).Value
        Next j
        
        myD_Book.Close SaveChanges:=False
    Next i

    Set myD_Book = Nothing
    Set myD_Sheet = Nothing
    Set mySummary_Sheet = Nothing

End Sub

図1●Aggregationマクロを実行した結果
図1●Aggregationマクロを実行した結果
[画像のクリックで拡大表示]