[[20140916155708]] 『動的配列で、配列要素がない場合の判断方法』(ろでます) ページの最後に飛ぶ

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

 

『動的配列で、配列要素がない場合の判断方法』(ろでます)

こんにちわ、いつもお世話になっております、ろでますです。
動的配列で、次の配列要素がない場合にエラー以外のなんらかの値を返すことができないでしょうか?
変数OPNには開いたファイルがvariant型の配列で渡されています。

OPNNum=Ubound(OPN)
redim OPN(OPNNum) ←この行は必要ないかも・・・

for i=1 to OPNnum

     Workbooks(OPN(i + 1)).Worksheets("Sheet1").Activate
     次月 = month(Range("A1"))
     Workbooks(OPN(i)).Worksheets("Sheet1").Activate
     処理月(i) = month(Range("A1"))

     if 次月<>処理月(i)
          a = 0
     end if
next i
要は次月のファイルが存在するときはそのブックとシート1をアクティブにして、変数「次月」に対し、次の月を代入します。
処理月(i)には、いわば今月とでも言いましょうか、その月の月を代入します。
しかし、当然このマクロでは、「OPN(i + 1)」などという要素は存在しないため、エラーが出ます。
そこで、以下のようなマクロも考えました。
OPNNum=Ubound(OPN)
redim OPN(OPNNum)

for i=1 to OPNnum

     On Error Resume Next
     Workbooks(OPN(i + 1)).Worksheets("Sheet1").Activate
     次月 = month(Range("A1"))
     On Error GoTo 0
     Workbooks(OPN(i)).Worksheets("Sheet1").Activate
     処理月(i) = month(Range("A1"))
     if 次月<>処理月(i)
          a = 0
     end if
next i

こんなマクロ組んでみました。
しかし、これだと変数「次月」にその前のループで代入された値が入り、この場合、
次月=処理月になってしまい、私のやりたい次月<>処理月になってくれません。

なので、動的配列 + 1の要素が「ない場合」に何か処理をできればと考えているのですが、何かいい方法はないでしょうか?
どなたか、良い方法がありましたら是非ともご教授いただけませんでしょうか?

よろしくお願い申し上げます。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 >redim OPN(OPNNum)
 これすると中身空っぽになっちゃいますけど、いいんですか?
 というか全体の流れが分からないので、箇条書きと本当にやりたいことを教えてもらえませんか?
 そもそもの処理でアプローチが間違っている可能性が高いです。(前回からの予想)
(稲葉) 2014/09/16(火) 16:58

 プログラミング用語で 先読み という方法ですよね!!

 こんな事例で考えましょうか!!

 配列myarray(1次元配列 1 to 10)に以下のようなデータが設定されているとします。

 添え字  値 
    1      1
    2      1
    3      1
    4      2
    5      2
    6      2
    7      2
    8      3
    9      3
   10      3

 この配列myarrayの内容が処理後には、

 添え字  値 
    1      
    2      
    3      1
    4      
    5      
    6      
    7      2
    8      
    9      
   10      3  

 つまり、同じ値が連続していたら、連続している最後の値だけ残し、それ以外は空白""にする

 という仕様です。

 これをコードにしてみると・・・、

 Option Explicit
 Sub test()
   Dim myarray(1 To 10) As Variant
   Dim g0 As Long
   For g0 = 1 To 3
      myarray(g0) = 1
   Next
   For g0 = 4 To 7
      myarray(g0) = 2
   Next
   For g0 = 8 To 10
      myarray(g0) = 3
   Next
   Range("a1:a10").Value = Application.Transpose(myarray)
   MsgBox "現在 配列myarrayの中身は、セルA1:A10のとおりです" & vbCrLf & "処理を開始します"
   For g0 = LBound(myarray) To UBound(myarray)
      If myarray(g0) = myarray(g0 + 1) Then
         myarray(g0) = ""
      End If
   Next g0
   Range("a1:a10").Value = Application.Transpose(myarray)
 End Sub

 上記を実行すると、

 >      If myarray(g0) = myarray(g0 + 1) Then
 で、「インデックスが有効範囲にありません。」というエラーでプログラムが止まります。

 ろでますさんが 提示されたコードと同じ原因です!!

 これをエラーを止めようと On error resume next を使ってみると・・・、
 Option Explicit
 Sub test2()
   Dim myarray(1 To 10) As Variant
   Dim g0 As Long
   For g0 = 1 To 3
      myarray(g0) = 1
   Next
   For g0 = 4 To 7
      myarray(g0) = 2
   Next
   For g0 = 8 To 10
      myarray(g0) = 3
   Next
   Range("a1:a10").Value = Application.Transpose(myarray)
   MsgBox "現在 配列myarrayの中身は、セルA1:A10のとおりです" & vbCrLf & "処理を開始します"
   On Error Resume Next
   For g0 = LBound(myarray) To UBound(myarray)
      If myarray(g0) = myarray(g0 + 1) Then
         myarray(g0) = ""
      End If
   Next g0
   Range("a1:a10").Value = Application.Transpose(myarray)
   On Error GoTo 0
 End Sub

 myarray(10)が""となってしまい(セルA10に結果が反映)、仕様どおりになりません。

 これも同じような結果ですよね!!

 On Error 〜 を使うという方法も実は、有効なんです。
 手法が分からない場合、とりあえず、エラートラップを拾って、それで分岐する方法。
 色々調べる余裕がない場合、有効です。

 Option Explicit
 Sub test3()
   Dim myarray(1 To 10) As Variant
   Dim wk As Variant
   Dim g0 As Long
   For g0 = 1 To 3
      myarray(g0) = 1
   Next
   For g0 = 4 To 7
      myarray(g0) = 2
   Next
   For g0 = 8 To 10
      myarray(g0) = 3
   Next
   Range("a1:a10").Value = Application.Transpose(myarray)
   MsgBox "現在 配列myarrayの中身は、セルA1:A10のとおりです" & vbCrLf & "処理を開始します"
   On Error Resume Next
   For g0 = LBound(myarray) To UBound(myarray)
      Err.Clear
      wk = myarray(g0 + 1)
      If Err.Number = 0 Then  'エラーが発生したら?
         If myarray(g0) = myarray(g0 + 1) Then
            myarray(g0) = ""
         End If
      End If
   Next g0
   Range("a1:a10").Value = Application.Transpose(myarray)
   On Error GoTo 0
 End Sub

 これで仕様通り作動しました。

 他にも

 エラーが発生するのは、最後g0=10 のときなので、10の時は、ループから外してしまう
 A10は、必ず、数字を残すのですから(今回の仕様の場合は)、何もしない。

 Sub test4()
   Dim myarray(1 To 10) As Variant
   Dim g0 As Long
   For g0 = 1 To 3
      myarray(g0) = 1
   Next
   For g0 = 4 To 7
      myarray(g0) = 2
   Next
   For g0 = 8 To 10
      myarray(g0) = 3
   Next
   Range("a1:a10").Value = Application.Transpose(myarray)
   MsgBox "現在 配列myarrayの中身は、セルA1:A10のとおりです" & vbCrLf & "処理を開始します"
   For g0 = LBound(myarray) To UBound(myarray) - 1
      If myarray(g0) = myarray(g0 + 1) Then
         myarray(g0) = ""
      End If
   Next g0
   Range("a1:a10").Value = Application.Transpose(myarray)
 End Sub

 又、g0=10の時が問題なのですから、g0=10の時をIF文で処理をしないように(今回の場合は)分岐する。

 Sub test5()
   Dim myarray(1 To 10) As Variant
   Dim g0 As Long
   For g0 = 1 To 3
      myarray(g0) = 1
   Next
   For g0 = 4 To 7
      myarray(g0) = 2
   Next
   For g0 = 8 To 10
      myarray(g0) = 3
   Next
   Range("a1:a10").Value = Application.Transpose(myarray)
   MsgBox "現在 配列myarrayの中身は、セルA1:A10のとおりです" & vbCrLf & "処理を開始します"
   For g0 = LBound(myarray) To UBound(myarray) 
      If g0 <> UBound(myarray) Then 'G0の値が配列の最大値だったら? 処理をしない
         If myarray(g0) = myarray(g0 + 1) Then
            myarray(g0) = ""
         End If
      End If
   Next g0
   Range("a1:a10").Value = Application.Transpose(myarray)
 End Sub

 このように先読みの場合は、ループの最後をどのようにするか考えることです。

( ichinose) 2014/09/17(水) 10:57


ichinoseさんにコメントを先にこされてしまいました。
その通りです、先読みです!。

一生懸命コメントを書いたので、コメント順番が後先逆になってしまいましたが、コメントを書かせていただきます。

>redim OPN(OPNNum)

すいません、ここは書き間違えでした。
正確には
redim preserve OPN(OPNNum)
です。

>というか全体の流れが分からないので、箇条書きと本当にやりたいことを教えてもらえませんか?

やりたいことは
1.月毎・年度毎、四半期毎等をドロップダウンリストで選択できるようにして、それに見合ったの売上計算をしたい
2.ただし、売り上げを計算したい場所(東京+千葉等)のファイル(データベース)は2つ(以上)ある。

というのが私のやりたいことです。

そこで、まず、計算した数字を入れる箱ファイルを
workbook.add
で作りました。
そして、シート内に「4月売上高」や「ボールペン」「サインペン」「その他」などのセルに必要な格子・文字列を記載するマクロをあらかじめ作りました。
四半期の場合は、できるファイルは3つ、つまり第一四半期の場合は
4月売上高.xlsx
5月売上高.xlsx
6月売上高.xlsx
です。

これを、単純に力技でやると確かにできるのですが、
3.マクロ自体の中にファイル名や、東京・千葉等の固有の場所等を入れたくない
4.年度や四半期なども力技で入れたくない。
要は、シート側で
5.ドロップダウンリスト+名前を使用し、他の部門でもシートだけ変更すれば使えるようにしたい
という願望があります。

なので、すべての条件はシート側から読み込み、それを変数に代入、ループ処理でこれらを処理したいと考えています。

これが概要です。

で、今つまづいているのが、どこで、「0」クリアを入れればいいのかを悩んでいます(というよりできません)
内容のマクロを簡単に書くとこうなります。
以下がうまくいっていないマクロです

Function 売上高集計(ByVal OPN)

    Dim 売上高 as long
    Dim OpnMthBkName As String
    Dim wb As Workbook

    OPNNum = UBound(OPN) '開くファイルの数を取得
    ReDim Preserve OPN(OPNNum) '開くファイルの配列宣言
    ReDim Preserve 処理月(OPNNum) '処理をする月を配列に入れるので、その宣言
    For i = 1 To OPNNum 'ファイルの数分のループを回す
        On Error Resume Next
        Workbooks(OPN(i + 1)).Worksheets("Sheet1").Activate '次のが何月であるかをあらかじめ取得しておくため、次に開く予定のファイルをアクティブに。
        次月 = month(Range("C2")) '←ここが間違っていると思われる次月を入れているところ
        On Error GoTo 0
        Workbooks(OPN(i)).Worksheets("Sheet1").Activate
        処理月(i) = month(Range("C2"))

        Set WSH = CreateObject("WScript.Shell")
        Path = WSH.SpecialFolders("Desktop") & "\"

	'既に処理月に対応したワークブックが開かれていれば、そのワークブックをアクティブにする
        For Each wb In Workbooks
            If wb.Name = Dir(Path & 処理月(i) & "売上高.xlsx") Then
                flag = True
            Exit For
            End If
        Next wb
        If flag = True Then
            wb.Activate
        Else
	'ワークブックが開かれていなければワークブックを追加する
            Workbooks.Add
            Set WSH = CreateObject("WScript.Shell")
            Path = WSH.SpecialFolders("Desktop") & "\"
        '既にデスクトップに同様のファイル名のファイルがあって、かつキャンセルを押されたときに、「保存されませんでした」というメッセージをだし、保存せず既存にあるファイルを開く。
            On Error Resume Next
            ActiveWorkbook.SaveAs Path & 処理月(i) & "売上高.xlsx"
            If Err.Number > 0 Then
                MsgBox "保存されませんでした"
                Application.DisplayAlerts = False
                ActiveWorkbook.Close
                Application.DisplayAlerts = True
                OpnMthBkName = Path & 処理月(i) & "売上高.xlsx"
                Workbooks.Open (OpnMthBkName)
            On Error GoTo 0
            Else
                OpnMthBkName = ActiveWorkbook.Name
            On Error GoTo 0
            End If
        End If

        Workbooks(OPN(i)).Worksheets("sheet1").Activate 'データベースがあるブックをアクティブにする。

        If 処理月(i) <> 次月 Then '←ここが間違っていると思われる点。
            売上高 = 0 '←ループで例えば4月のファイルを2つ開いた場合、ここで0クリアをしないと。
           ' ループとしては4月(東京)⇒4月(千葉)⇒5月(東京)⇒5月(千葉)・・・と回ってくるので、要は「月が変わった時点で0クリアしないといけない」ということになります。       
        End If
        'データベース用のブックから、「消しゴム」や「鉛筆」などの売上高(ワークシート関数で集計後)がを変数に代入
        その他=その他+Range("A1") 'Range("A1")には消しゴムの売上高が入っている(データベースから、Conutifsなどを使って、売上高を集計後の売上高が入っています)
        その他=その他+Range("A2") 'Range("A2")には鉛筆の売上高が入っている(データベースから、Conutifsなどを使って、売上高を集計後の売上高が入っています)
	サインペン=Range("A3")(データベースから、Conutifsなどを使って、売上高を集計後の売上高が入っています)
        ボールペン=Range("A4")(データベースから、Conutifsなどを使って、売上高を集計後の売上高が入っています)
    next i
	以下、代入されたデータを「OpnMthBkName」ブックに転記してグラフ化するマクロが書かれていますがここは割愛します。

このマクロは明らかに間違いで、例えば第一四半期の売上高を集計する場合、ループは4月⇒4月⇒5月⇒5月⇒6月⇒6月とデータベース用のファイルが開かれていきます。
しかし、

        If 処理月(i) <> 次月 Then
            売上 = 0
    End If
の部分を単に
売上高 = 0
にしてしまうと、4月(東京)⇒0クリア⇒4月(千葉)・・・という形で4月分の合計が出ません。(このループで行くと、千葉分しか入らなくなります)
そこで考えたのが、
        If 処理月(i) <> 次月 Then '←ここが間違っていると思われる点。
            売上高 = 0 '←ループで例えば4月のファイルを2つ開いた場合、ここで0クリアをしないと。
           ' ループとしては4月⇒4月⇒5月⇒5月・・・と回ってくるので、要は「月が変わった時点で0クリアしないといけない」ということになります。       
        End If
でした。
これならば月が変わった時点で0クリアされるだろうと思ったのですが、最終月、つまり6月の場合、変数「次月」には「5月」が入ってしまいます。
結局、6月のブック(OpnMthBkName)にはデータベース5月の分と6月の分が合算された値が入ってしまいます。

そこで、質問の表題のご質問をさせていただきました。
もし、

Workbooks(OPN(i + 1)).Worksheets("Sheet1").Activate
次月 = month(Range("C2"))
On Error GoTo 0

で、エラーではなく「OPN(i + 1)」には「配列が存在しないよ!」というよなものを返すことができれば、

If 処理月(i) <> 次月 Then

    売上 = 0
End If

ここがTrueを返すため、6月の売上高を0クリアにすることができると考えています。
ですので、このような表題の質問をさせていただきました。

長々と長文&下手なマクロ&理解しづらいマクロで大変恐縮なのですが、正直大変煮詰まっています。
是非とも何かいい解決策があればご教授願えませんでしょうか。
よろしくお願い申し上げます。
(ろでます) 2014/09/17(水) 11:06


こんにちわ、ろでますです。

ichinoseさんから頂いたコメントをもとに、少々小アレンジすることはありましたが、できました!
ちゃんと最後の配列に、仕様通りの値が入ってくれました!

大変ありがとうございます!
また、何かございましたら(何かないのが一番なのですが)、是非ともアドバイスのほどをよろしくお願い申し上げます。
(ろでます) 2014/09/17(水) 13:37


と思ったら、トラップにはまってやっぱり駄目だったことが判明いたしました(泣
詳細は後程・・・。
(ろでます) 2014/09/17(水) 14:08

こんにちわ、ろでますです。
トラップにはまったという理由をご説明させていただきます。

まず、ichinoseさんから頂いたコメントをもとに作ったマクロは以下の通りです。

    For i = 1 To OPNNum
        On Error Resume Next
        Workbooks(OPN(i + 1)).Worksheets("sheet1").Activate
        If Err.Number = 0 Then
            次月 = month(Range("C2"))
        Else
            次月 = 次月 + 1
        End If
        MsgBox 次月
        On Error GoTo 0
        Workbooks(OPN(i)).Worksheets("sheet1").Activate
        処理月(i) = month(Range("C2"))        
以下同様なので略・・・

しかしながら先に私がやりたいことでは、場所(東京・千葉)が2つあります。
つまり、ファイル構成配列OPNはは第一四半期の場合、以下の通りになります
OPN(1)=4月東京売上高.xlsx
OPN(2)=5月東京売上高.xlsx
OPN(3)=6月東京売上高.xlsx
OPN(4)=4月千葉売上高.xlsx
OPN(5)=5月千葉売上高.xlsx
OPN(6)=6月千葉売上高.xlsx
という形になります。
つまり、確かに5月⇒6月の遷移で次月に6月を入れることはできるのですが、今度は
東京⇒千葉(つまりOPN(3)⇒OPN(4))と遷移した場合、
Workbooks(OPN(i + 1)).Worksheets("sheet1").Activate
は「存在してしまう」ので
If Err.Number = 0 Then

    次月 = month(Range("C2"))
がTrueになってしまうため、
次月の遷移は
5月(東京)
6月(東京)
5月(千葉)
6月(千葉)
7月(千葉)
という形になってしまい、
結果、東京の7月分の値が集計できない形になってしまっています。
そもそも、稲葉様の言うとおり、アプローチの仕方が間違っているのでしょうか・・・。
例えば、東京なら東京だけを集計するブックをまず作り、次に千葉だけを集計するブックを作り、そこから2つのブックの値を合算するという手法を用いるのが初心者としてはまっとうな方法でしょうか・・・。
複数の場所と、複数の月をまとめて一つのループでやろうとするから無理が出る・・・のでしょうか。
もう、煮詰まって煮詰まって・・・。
以前稲葉様に教えていただいたコレクション返しなどは「手法」が主だったと私は考えていますが、今回はどちらかというとアルゴリズムやフローといった分類なので私のコメントを読んでいただいても、非常に伝えづらいと思っています。

本当に・・・良いコメントをいただいたのに・・・申し訳ない気持ちでいっぱいです。
(ろでます) 2014/09/17(水) 14:40


  4月じゃなくて7月が出てきたり、
変数名が「売上高」なのか「売上」なのかぶれていたり
もうちょっと落ち着いて正確に書いていただかないとこちらも混乱してしまいます。
 
改善点を示すのが大変なので、なんとなくやりたいことってこういう感じ?という
考え方の一例です。
私ならこんな風に進めるかなという。
なじまなければスルーしてください。
 
Option Explicit
Sub 考え方()
    Dim list処理月 As New Collection
    Dim 処理月 As Variant
    Dim 四半期 As String
    Dim 売上高 As Currency
    Dim OPN() As String
    Dim i As Integer
    'テスト用
    OPN = Split("4月東京売上高.xlsx,5月東京売上高.xlsx,6月東京売上高.xlsx,4月千葉売上高.xlsx,5月千葉売上高.xlsx,6月千葉売上高.xlsx", ",")
    'セルの値とかで設定
    四半期 = Range("A1").Value
    '四半期に入っている値で処理対象月を決定
    Select Case 四半期
        Case "第1"
            list処理月.Add "4月"
            list処理月.Add "5月"
            list処理月.Add "6月"
        Case "第2"
            list処理月.Add "7月"
            list処理月.Add "8月"
            list処理月.Add "9月"
        Case "第3"
            list処理月.Add "10月"
            list処理月.Add "11月"
            list処理月.Add "12月"
        Case "第4"
            list処理月.Add "1月"
            list処理月.Add "2月"
            list処理月.Add "3月"
    End Select
    '処理対象に決まった月を順に処理
    For Each 処理月 In list処理月
        '初期化
        売上高 = 0
        '集計対象となるブック名の一覧を回す
        For i = LBound(OPN) To UBound(OPN)
            'ブック名から、今から処理したい月以外は飛ばす
            If Left(OPN(i), Len(処理月)) <> 処理月 Then
                GoTo NEXT_BOOK '次のブック名へ
            End If
            'ブック名が処理したい月と一致している場合だけ処理
            MsgBox OPN(i) & " を " & 処理月 & "売上高.xlsx に集計していく"
NEXT_BOOK:
        Next
    Next
    MsgBox "end"
End Sub
#18:17 ちょと調整
(ご近所PG) 2014/09/17(水) 18:12

>ご近所PG様
コメントありがとうございます。
すいません、言い訳になっていますが、業務の合間を縫ってVBAのほうは行っているので、少々焦りながらやっているのもありまして・・・。
ほんとに言い訳です・・・すいません。

コメントいただいた内容は、明日にでもじっくり理解&調べてご参考にさせていただきます。
ありがとうございます。
(ろでます) 2014/09/17(水) 21:44


 エラートラップで分岐ができないなら、ご自身が理解されているようにそれは、考え方を変えなければなりませんよね!!

 記述の問題点は、例えば、変数「次月」の値の変遷一つとっても、間違った結果は、記述されていますが、
 正しい結果は、記述されていませんよね!! 本来なら、対比できるように両方を記述するべきですよ!!

 本来は 変数次月は、

 5,6,7,5,6,7 と変遷すればよかったのですか?

 だとしたら、東京から千葉にかわることがわかるデータが何なのか?何を比較すればそれが検知できるのか
 を ろでますさんが考えなければなりませんね!! 東京から千葉に変わったことがわかる識別子は?

 ブック名が例題のようなブック名なら、そこから識別できますが、ブック名には本来規則性がなかったのでしたっけ?

 私は、全体の仕様を把握していないので この程度しか記述できませんが・・・。

 

( ichinose) 2014/09/18(木) 05:47


おはようございます、ろでますです。
>ichinose様

>エラートラップで分岐ができないなら、ご自身が理解されているようにそれは、考え方を変えなければなりませんよね!!
以下略・・・

はい、その通りだと思っています。
ご近所PG様の手法も理解&調べてまずその方法でできるかどうかを試してみたいとは思っています。

しかしながら、最初にコメントいただいた稲葉様や、今コメントいただきましたichinose様のおっしゃる通り、そもそものマクロの流れ、考え方(アプローチのしかた)に問題があると思います。

ichinose様のおっしゃる通り、「何を比較すればそれが検知できるのか」、「東京から千葉に変わったことがわかる識別子は」を、きっちり分離すべきだと思っています。

しかし、手法や手段というものは教えていただくことができて、理解し、実践することは、困難ではありますがじっくり理解&調べさえ調べさえすれば遂行することは可能だとは思いますが、フローや流れなどは自分にしか分からないものですから、おっしゃる通り私自身が考え、解決する問題ですね。

いろいろ考えてみようかと思います。
(ろでます) 2014/09/18(木) 09:31


 コードだけ読み取って組み立て直してみました。
 先読みという手法というより個人的にはグループ化だと思っているのですが・・・
 順番が前後しても合計させないと、破綻しそうなコードでしたので、そこからメスを入れてみました。
    Sub test()
        Dim OPN(1 To 6)
        OPN(1) = "東京4.xlsm"
        OPN(2) = "東京6.xlsm"
        OPN(3) = "千葉5.xlsm"
        OPN(4) = "東京5.xlsm"
        OPN(5) = "千葉6.xlsm"
        OPN(6) = "千葉4.xlsm"
        売上高集計 (OPN)
    End Sub
    Function 売上高集計(ByVal OPN)
        '//OPNにあるファイル名の月を取り出し、月毎にファイル名を文字列として繋ぐ
        Dim dic As Object
        Dim BN, 月 As String
        Set dic = CreateObject("Scripting.Dictionary")
        For Each BN In OPN
            月 = Month(Workbooks(BN).Sheets("Sheet1").Range("C2").Value)
            If Not dic.exists(月) Then
                dic.Add 月, BN
            Else
                dic(月) = dic(月) & Chr(2) & BN
            End If
        Next BN

        '//月毎に売上を合計する
        Dim k
        Dim 売上 As Object
        Set 売上 = CreateObject("Scripting.Dictionary")
        For Each k In dic.keys
            売上.Add k, CreateObject("Scripting.Dictionary")
            売上(k).Add "その他", 0
            売上(k).Add "ボールペン", 0
            売上(k).Add "サインペン", 0
            For Each BN In Split(dic(k), Chr(2))
                With Workbooks(BN).Sheets("Sheet1")
                    売上(k)("その他") = 売上(k)("その他") + .Range("A1") 'Range("A1")には消しゴムの売上高が入っている(データベースから、Conutifsなどを使って、売上高を集計後の売上高が入っています)
                    売上(k)("その他") = 売上(k)("その他") + .Range("A2") 'Range("A2")には鉛筆の売上高が入っている(データベースから、Conutifsなどを使って、売上高を集計後の売上高が入っています)
                    売上(k)("サインペン") = 売上(k)("サインペン") + .Range("A3") '(データベースから、Conutifsなどを使って、売上高を集計後の売上高が入っています)
                    売上(k)("ボールペン") = 売上(k)("ボールペン") + .Range("A4") '(データベースから、Conutifsなどを使って、売上高を集計後の売上高が入っています)
                End With
            Next BN
        Next k

        '//売上高を入れるブックに、合計を入れる(敢えて↑のループと分ける、役割が異なるので) 一緒にするなら、売上のキーは直接「ボールペン」等
        Dim Desk_PATH As String
        Dim WB As Workbook
        Desk_PATH = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
        For Each k In 売上.keys

            '//開かれたファイルをセット エラ→ ファイルを開く エラ→ ファイルを作成する
            On Error Resume Next
                Set WB = Workbooks(k & "売上高.xlsx")
                If Err > 0 Then
                    Err.Clear
                    Set WB = Workbooks.Open(Desk_PATH & k & "売上高.xlsx")
                    If Err > 0 Then
                        Set WB = Workbooks.Add
                        WB.SaveAs Desk_PATH & k & "売上高.xlsx"
                    End If
                End If
            On Error GoTo 0

            '//月別のブックに結果を出力
            With WB.Sheets("Sheet1")
                .Range("A1").Value = 売上(k)("その他")
                .Range("A2").Value = 売上(k)("サインペン")
                .Range("A3").Value = 売上(k)("ボールペン")
                WB.Close savechanges:=True
            End With
        Next k
    End Function

(稲葉) 2014/09/18(木) 10:42


 あれ読み直したら考え方違った!?
 東京の4〜6の集計
 千葉の4〜6の集計
 って感じにやりたいのかな・・・

 ↑のコードは
 東京と千葉の4月
 東京と千葉の5月
 東京と千葉の6月

 となっています。

 東京と千葉を判断する基準が「ブック名」なら簡単に出来ますけど、どうなんでしょう?
(稲葉) 2014/09/18(木) 10:47

>稲葉様
ちょうど私もそれを考えていたところでした。
データベース用のファイルに対しファイル命名規則を付けて、それで判断すればいいかと思っていました。
以前教えて頂いた、ファイルの開く方法でDBをひらいて、その際の名前が
例えば
OPN(1)=4月_東京_売上高DB.xlsx
OPN(2)=5月_東京_売上高DB.xlsx
OPN(3)=6月_東京_売上高DB.xlsx


OPN(6)=6月_千葉_売上高DB.xlsx
とし、文字列変数に格納。
これを、区切り文字「_」で区切って、地名部分を判断すればできるかな〜というレベルで今考えているところでした。

まだ本当に「出来るかな〜」と思っている程度なので、フローやインプリメントのやり方などはこれから考えようかと思っています。
とりあえず、この方法で、まず人に頼らず、自分の力で考えてみようと思います。
(ろでます) 2014/09/18(木) 12:17


 一定の規則があるのでそのままでも抜き出せますよ。
 月と売を探してその間の文字を抜き出すサンプルです。
 先ほど提示したデータの一番最初のループ部分です。

    Function 売上高集計(ByVal OPN)
        '//OPNにあるファイル名の地区を取り出し、地区毎にファイル名を文字列として繋ぐ
        Dim dic As Object
        Dim BN, 地区 As String
        Set dic = CreateObject("Scripting.Dictionary")
        With CreateObject("VBScript.RegEXP")
            .Pattern = "(月)(\W+)(売上)": .Global = True
            For Each BN In OPN
                If .test(BN) Then
                    地区 = .Execute(BN)(0).submatches(1)
                    If Not dic.exists(地区) Then
                        dic.Add 地区, BN
                    Else
                        dic(地区) = dic(地区) & Chr(2) & BN
                    End If
                End If
            Next BN
        End With
 (以下同文のため省略)        

(稲葉) 2014/09/18(木) 12:42


稲葉様、コメントありがとうございます。
正直なコメントを申し上げます。気を悪くなさらずに読んでください。

確かにこのマクロを私のマクロに引っ付ければ動くかもしれません。
しかしながら、なぜ動作するのか?という理解ができないと、まったく意味がないと思っています。
正直なところ、稲葉様から頂いたマクロをGoogle先生やヘルプを読んでも、まったく理解できないというのが私の現状、スキルです。以前ご指導いただきましたコレクションと全く同じ状況です。あの時は、かなり教えていただいて、そうして何とか理解できました。

大変ご無理なお願いになりますが、もし可能ならで結構です。
あきれ果てたのならスルーしていただいてもかまいません。

頂いたマクロの解説を頂けることはできないでしょうか?。
本当にいつもご迷惑おかけしてばかりで申し訳ないと思っています。

何卒、お頼み申し上げます。

(ろでます) 2014/09/18(木) 15:03


 コード別に書きこむのでお時間ください。
 ichinoseさんのように旨く説明出来ないし、他の方から見れば稚拙なコードかもしれませんが
 なるべくわかりやすく記述したことを説明したいと思います。
(稲葉) 2014/09/18(木) 15:07

 最初のくだり
        '//OPNにあるファイル名の地区を取り出し、地区毎にファイル名を文字列として繋ぐ
        Dim dic As Object
        Dim BN, 地区 As String
        '//連想配列の「Dictionary」オブジェクトをdic変数にセットする
        '  連想配列は、一意のKeyとItemから成ります
        '  Keyが重複しているかどうか、existsプロパティで調べて、重複しなければKeyを追加し、ブック名を文字列で入れる
        '  重複していればそのKeyのItemに、前回の結果を続けて文字列として繋ぐ。接続詞は「Chr(2)」例は便宜的に「_」
        '  例:Key:=東京,Item:=5月東京売上高.xlsm_4月東京売上高.xlsm_6月東京売上高.xlsm
        '  そして、これを後ほどSplit関数で配列にし、For Eachで回します。
        Set dic = CreateObject("Scripting.Dictionary")

        '//RegEXP 正規表現検索
        'http://www.mnet.ne.jp/~nakama/
        '  5月東京売上高.xlsm
        '   ~~    ~~~~
        '  ↑の下線を検索して、その間にある「東京」を抜き出したい
        '  .Pattern = "(月)(\W+)(売上)" ()はグループ化 \W+は数値と英数以外の文字が少なくとも1文字以上続くこと
        '  この検索条件を設定していて、test(地区)で、条件が当てはまる文字列が存在しているか確認しています。
        '  当てはまる文字がある場合、
        '  .Execute(BN)(0).submatches(1)
        '   ~~~~~~~    ~~~ ~~~~~~~~~~~~~
        '  ExecuteメソッドでMatchesコレクション(0から始まる配列)を取得し、
        '  submatches(1)プロパティ(これも0から始まる配列)で、2文字目を抜き出しています。
        '  具体的には    Executeの中身     (0):=Array(月,東京,売上)
        '                submatchesの中身  (0):=月 (1):=東京 (2):=売上
        '  となっているので、配列(0)の中の配列(1)の東京を抜き出すことが出来ます。
        With CreateObject("VBScript.RegEXP")
            .Pattern = "(月)(\W+)(売上)": .Global = True
            For Each BN In OPN
                If .test(BN) Then
                    地区 = .Execute(BN)(0).submatches(1)
                    If Not dic.exists(地区) Then
                        dic.Add 地区, BN
                    Else
                        dic(地区) = dic(地区) & Chr(2) & BN
                    End If
                End If
            Next BN
        End With

(稲葉) 2014/09/18(木) 15:26


 2つ目のコード
        '//地区毎に売上を合計する
        Dim k
        Dim 売上 As Object
        '//売上という連想配列を作成する。Dictionaryについては先ほど説明したので割愛します。
        Set 売上 = CreateObject("Scripting.Dictionary")

        '//先ほど作成した、dicのキーコレクションをFor Eachで回します。
        '  keysメソッドはすべてのkeyを配列として返します
        '  下記の場合、Array(東京,千葉)のように変数kが変化します。
        For Each k In dic.keys

            '//地区ごとに合計したいので、売上にKeyを渡して、更にその中に連想配列を作成します。
            '  考え方は  売上(東京)(ボールペン) = 10本  このような考え方になります。
            売上.Add k, CreateObject("Scripting.Dictionary")
            売上(k).Add "その他", 0
            売上(k).Add "ボールペン", 0
            売上(k).Add "サインペン", 0

            '//今後は、dicにkを渡して、Itemを取り出し、更にそのItemをSplitで配列にしてFor Eachで回します。
            '  dic(k)のitemは "5月東京売上高.xlsm_4月東京売上高.xlsm_6月東京売上高.xlsm" このような文字列ですので、
            '  これをArray(5月東京売上高.xlsm , 4月東京売上高.xlsm , 6月東京売上高.xlsm) このような配列にしています。
            '  ここのループでは、dic(東京)のitme5月東京売上高.xlsm , 4月東京売上高.xlsm , 6月東京売上高.xlsmの売上を合計する
            '  というループです。
            '  こうすることで、先読みしなくても、グループ化されたそれぞれの地区の合計を出すことが出来ます。
            For Each BN In Split(dic(k), Chr(2))
                With Workbooks(BN).Sheets("Sheet1")
                    売上(k)("その他") = 売上(k)("その他") + .Range("A1")
                    売上(k)("その他") = 売上(k)("その他") + .Range("A2")
                    売上(k)("サインペン") = 売上(k)("サインペン") + .Range("A3")
                    売上(k)("ボールペン") = 売上(k)("ボールペン") + .Range("A4")
                End With
            Next BN
        Next k

        '補足
        '合計する項目(ボールペンやサインペン)が多い場合は、↑のやり方は向いていないかもしれません。
(稲葉) 2014/09/18(木) 15:51

 最後のコード
        '//売上高を入れるブックに、合計を入れる(敢えて↑のループと分ける、役割が異なるので) 一緒にするなら、売上のキーは直接「ボールペン」等
        Dim Desk_PATH As String
        Dim WB As Workbook

        '//変数「PATH」は他のコードでは予約語として扱われていることがあり、なるべく変数名で使わない方が分かりやすいです。
        '  例えばThisWorkbook.Path ←このプロパティも「Path」ですよね? なので、「Desk_PATH」に名前を変えました。
        '  また、オブジェクトは一々変数に入れなくても使用出来ます。
        Desk_PATH = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

        '//先ほど作った売上のkey(dicのキーと同じになります)でFor Eachを回します。
        '  先のループで処理した方がスマートですが、役割が異なるコードを同じループで回していると、後で
        '  何が主目的なのか分からなくなってしまうので、私は分けるようにしています。
        For Each k In 売上.keys

            '//WBに開かれたファイルをセットし、エラーならば
            '  WBに既存のファイルを開いてセットし、エラーならば
            '  WBに新しいブックをセットして、名前を付けて保存する
            '  Err.Clearは、同じOn Errorルーチン内だとリセットされませんので、明示的にリセットを掛けています。
            '  ろでますさんは新しいブックを作って保存しようとしたときに、既にブックがあれば・・・の順に処理していますが、
            '  そうすると、新しく作ったブックを破棄するコードも必要なので、順番を変更しました。
            On Error Resume Next
                Set WB = Workbooks(k & "売上高.xlsx")
                If Err > 0 Then
                    Err.Clear
                    Set WB = Workbooks.Open(Desk_PATH & k & "売上高.xlsx")
                    If Err > 0 Then
                        Set WB = Workbooks.Add
                        WB.SaveAs Desk_PATH & k & "売上高.xlsx"
                    End If
                End If
            On Error GoTo 0

            '//地区別のブックに結果を出力
            '  この辺りは想像でしかありません。最後の出力はろでますさんから提示がありませんでしたので・・・
            With WB.Sheets("Sheet1")
                .Range("A1").Value = 売上(k)("その他")
                .Range("A2").Value = 売上(k)("サインペン")
                .Range("A3").Value = 売上(k)("ボールペン")
                WB.Close savechanges:=True
            End With
        Next k

 以上で解説終りです。
 分かりにくいでしょうか? 分かりにくいですよね・・・
 1)地区ごとにブック名をグループ化する
 2)グループ化したブック名を地区ごとに合計させる
 3)合計結果を特定のブックに出力する
 の3部構成です。
(稲葉) 2014/09/18(木) 16:08

こんにちわ、ろでますです。
>稲葉様

とりあえず、最初の下りから一つ一つ理解しようと現在必死に調べたりしているのですが、最初の下りの視点で理解できない点が既に2つございます(スキル不足で申し訳ありません)。

【1】
.Pattern = "(月)(\W+)(売上)"
がなぜ()でグループ化されているのかがわかりまん。
稲葉様から頂いたHPで正規表現の勉強をさせていただいたのですが、()はグループ化とありました。
しかし、今回の場合BN⇒OPN⇒「5月東京売上高.xlsm」から「(月)(\W+)(売上)」で検索すると、抜き出されるのは
「月東京売上」
という文字が検索でヒットし、結果
.Test(BN)はTrueが返ると理解できてしまいます。
だとすると、
.Pattern = "(月)(\W+)(売上)"
は単純に考えてしまって申し訳ありませんが
.Pattern = "月\W+売上"
でも同じではないかと思ってしまいます。
これが、理解できない点【2】につながるのかどうかは分かりませんが、
【2】
>' 具体的には Executeの中身 (0):=Array(月,東京,売上)
>' submatchesの中身 (0):=月 (1):=東京 (2):=売上
のところで、なぜExecuteの中身が「月,東京,売上」となっているかということです。
色々私も調べているのですが、とあるHPで
「Executeメソッドは、マッチングの結果をMatchesコレクションとして返します」
とありました。
そうすると私の理解だと
With Matches

    .Add Item:="月東京売上"
End With
だと理解してしまいました。
稲葉様の提示して頂いた内容だと以下のようになるのでしょうか?
With Matches(0)
    .Add Item:="月"
    .Add Item:="東京"
    .Add Item:="売上"
End With
になるのでしょうか?。ここがかなり理解できないポイントです。
合わせて、「submatchesの中身  (0):=月 (1):=東京 (2):=売上」ということは、正規表現「.Pattern = "(月)(\W+)(売上)"」で3つの検索結果が見つかったということを意味していると理解しています。
つまりは、「(月)(\W+)(売上)"」にすることにより、Matchesコレクションには「(0):=Array(月,東京,売上)」が入り、submatchesの中身には「(0):=月 (1):=東京 (2):=売上」という理解になるのでしょうか?
要は()が今回の正規表現&検索では要となっているのかどうかということが私には理解できないのです。

すいません、これだけ丁寧に解説いただいたのに、私の理解力不足でわからない点だらけで本当に申し訳ございません。
何卒ご教授のほどをよろしくお願い申し上げます。
(ろでます) 2014/09/19(金) 12:09


 ほぼその通りですが、一部違います。
 >正規表現「.Pattern = "(月)(\W+)(売上)"」で3つの検索結果が見つかったということを意味している
 これは「この組合せが1つ見つかって、その組合せは3つの部分に分かれている」ということになります。
 つまり、
 6月_東京売上 ×
 6月東京_売上 ×
 6月_東京_売上 ×
 6_月東京売上 ○
 あくまで「月文字売上」のセットが1つ見つかったということです。
 テスト2で解説します。

 まず下記のプログラムを走らせて、ローカルウィンドウで確認してください。
 テスト用プログラム
    Sub rotest()
        Dim Reg As Object
        Dim Mat_one, Sub_one
        Dim Mat_two, Sub_two
        Dim Moj As String
        Moj = "abc123ghi"
        Set Reg = CreateObject("VBScript.RegEXP")
        Reg.Pattern = "c\d+g"
        Set Mat_one = Reg.Execute(Moj)
        Reg.Pattern = "(c)(\d+)(g)"
        Set Mat_two = Reg.Execute(Moj)
        Set Sub_one = Mat_one(0).submatches
        Set Sub_two = Mat_two(0).submatches
        Stop
    End Sub
 この例ではMat_oneとMat_twoの1階層目に違いはありません。(その奥は異なります。)
 次に
 Sub_oneはアイテムが無いのに対して
 Sub_twoはアイテムが3つあります。
 これが()を付けてグループ化した理由です。

 テスト用プログラム2
    Sub rotest2()
        Dim Reg As Object
        Dim Mat_one, Sub_one
        Dim Mat_two, Sub_two
        Dim Moj As String
        Moj = "abc123ghiabc456ghi"
        Set Reg = CreateObject("VBScript.RegEXP")
        Reg.Pattern = "(c)(\d+)(g)"
        Set Mat_one = Reg.Execute(Moj)
        Reg.Global = True
        Set Mat_two = Reg.Execute(Moj)
        Set Sub_one = Mat_one(0).submatches
        Set Sub_two = Mat_two(0).submatches
        Stop
        Set Sub_one = Mat_one(1).submatches '←エラーになるはず
        Set Sub_two = Mat_two(1).submatches
        Stop
    End Sub
 今度はGlobalとMojが"abc123ghiabc456ghi"に増えたことに注目してください。
 ちょっと今日これから外に出るのではしょりますが、

 Mat_oneではItemが一つに対し、
 Mat_twoではItemが二つありますよね?
 つまりc\d+gのパターンがMojの中に二つ見つかったということになります。
 これが「3つの検索結果が見つかった」という理解が「間違っている」ということになります。

 これがGlobalを付けるかつけないかの差です。
 ※私の提示したコードにGlobal=Trueがあるのは癖です!!今回は必要ありません!

 すみません、簡単ですが後は返ってきて質問があればお答えします。  
(稲葉) 2014/09/19(金) 12:47

稲葉様、コメントありがとうございます。
私も、明日から飛び石連休に休みを取ってしまうので、また、次にコメントできるのは来週になってしまいますが、それでも、とりあえずこの場でコメントをさせていただきたい思います。

おっしゃる通り、ローカルウィンドで確認すると変数の流れがよく理解できました。
試にいろいろ試してみました。
まず頂いた1つ目のマクロの方で
Reg.Pattern = "(c)(\d+)(g)"

Reg.Pattern = "(c)(\d+g)"
に変更すると、確かにsubmatchesの数が3⇒2に変化しました。
ということは、やはり()で括ることによりsubmatchesのItem数に影響を与える、つまりは()はsubmatchesを分ける正規表現だと理解をしました。

次に、いただいた2つ目のマクロで
Reg.Global = True

Reg.Global = False
にすると、Mat_oneのItemもMat_twoのItemも両方1つになり同じ結果が返ってくるようになりました。
ということは、GlobalはFalseにすると「検索対象文字列の先頭から検索し、最初にマッチングした値のみを返す」と理解いたしました。

もし間違っている様でしたらご指摘ください。
よろしくお願い申し上げます。
(ろでます) 2014/09/19(金) 14:00


こんにちわ、ろでますです。
あらかじめで申し訳ないのですが、2つ目のコードに対するご質問を先書かせていただきます。

まず
>'//先ほど作成した、dicのキーコレクションをFor Eachで回します。
中略
>売上(k).Add "サインペン", 0
ですが、ここは、まず考え方なのですが、連想配列の2次元配列と理解しました。
しかしながら、以下のマクロがある理由が理解できませんでした。

>売上.Add k, CreateObject("Scripting.Dictionary")

これが何を意味するのかが理解できません。
なぜかと申し上げますと、
配列名「売上」で連想配列の要素が「k」これが東京⇒千葉のように変化する。これが一次元目。
そして、

>売上(k).Add "その他", 0

で、この「その他」が二次元目。
つまりこの時点で例として
売上(東京)(その他)=0
となっていると理解してしまっています。
そのためなぜわざわざ
>売上.Add k, CreateObject("Scripting.Dictionary")
というマクロが必要なのかがわかりませんでした。

あと、2つのFor〜Eachの考え方というかフローですが、
まず、1つ目のFor文
>For Each k In dic.keys
が必要な理由が理解できませんでした。
ここは、後に回す
>For Each BN In Split(dic(k), Chr(2))
で、全てのファイルが地区ごとに回る
つまりは
売上(東京)(その他)=四半期の東京のその他の売上合計が入る
売上(東京)(ボールペン)=四半期の東京のボールペンの売上合計が入る


仮にここで、「千葉」という地区が出てきたとしても、変数kが「東京」や「千葉」と変わるのだから、結果として、
売上(千葉)(ボールペン)=四半期の千葉の売上合計が入るので、結果としてちゃんと地区毎・四半期ごとの売り上げが入ると理解してしまいました。
つまり、以下のようでもよいのではないかと解釈してしまったのです。

        Dim k
        Dim 売上 As Object
        Set 売上 = CreateObject("Scripting.Dictionary")
        For Each k In dic.keys

            売上(k).Add "その他", 0
            売上(k).Add "ボールペン", 0
            売上(k).Add "サインペン", 0

        Next k

        For Each BN In Split(dic(k), Chr(2))
            With Workbooks(BN).Sheets("Sheet1")
                売上(k)("その他") = 売上(k)("その他") + .Range("A1")
                売上(k)("その他") = 売上(k)("その他") + .Range("A2")
                売上(k)("サインペン") = 売上(k)("サインペン") + .Range("A3")
                売上(k)("ボールペン") = 売上(k)("ボールペン") + .Range("A4")
             End With
         Next BN

です。
しかし、おそらく、これはきっと間違いなのでしょう。
何が間違っているのか、それが理解できないのです。

申し分かりません、お願いばかりで申し訳ございませんが、アドバイスの方、何卒よろしくお願い申し上げます。
(ろでます) 2014/09/19(金) 15:50


 >>売上.Add k, CreateObject("Scripting.Dictionary") 
 >というマクロが必要なのかがわかりませんでした。
 実際やっていただいたほうが早いのですが

 サンプルのデータです。
	[A]	[B]	[C]
[1]	地区	品名	金額
[2]	東京	トマト	100
[3]	千葉	みかん	600
[4]	千葉	りんご	400
[5]	東京	トマト	700
[6]	東京	みかん	100
[7]	東京	りんご	200
[8]	千葉	トマト	400
[9]	東京	みかん	500
[10]	千葉	りんご	300
[11]	東京	トマト	500
[12]	千葉	みかん	900
[13]	千葉	りんご	500

    Sub rodictest()
        Dim tbl
        Dim 行 As Variant
        Dim 地区 As Object
        Dim 売上 As Object
        Const 地名 As Long = 1
        Const 品名 As Long = 2
        Const 金額 As Long = 3
        tbl = Range("A1").CurrentRegion.Value

        Set 地区 = CreateObject("Scripting.Dictionary")
        For 行 = 2 To UBound(tbl, 1)
            If Not 地区.exists(tbl(行, 地名)) Then
                地区.Add tbl(行, 地名), 行
            Else
                地区(tbl(行, 地名)) = 地区(tbl(行, 地名)) & Chr(2) & 行
            End If
        Next 行

        Set 売上 = CreateObject("Scripting.Dictionary")
        For Each k In 地区.keys
            '売上.Add k, CreateObject("Scripting.Dictionary") '●これを入れないと
            '売上.Add k, ""                                   '■↑が必要ならこっちでもいいのではないか?
            売上(k).Add "トマト", 0                           '●■ともにここでオブジェクトが必要ですエラーになる。なぜ?
            売上(k).Add "みかん", 0
            売上(k).Add "りんご", 0
            '▼このループを外に出す
            'For Each 行 In Split(地区(k), Chr(2))
            '    売上(k)(tbl(行, 品名)) = 売上(k)(tbl(行, 品名)) + tbl(行, 金額)
            'Next 行
            '▲
        Next k

        Stop
        '▼外に出すとループされない。なぜ?
        For Each 行 In Split(地区(k), Chr(2))
            売上(k)(tbl(行, 品名)) = 売上(k)(tbl(行, 品名)) + tbl(行, 金額)
        Next 行
        '▲
    End Sub

 これはろでますさんが「これでもいいんじゃないの?」という点を解説するためのコードです。
 ●と■と▲で解説します。適宜コメントアウトを外して挙動の違いを確かめてください。

 ●のところではkを「東京」としたとき
 売上のkey(東京)に、新しいkey「トマト」を入れようとしています。
 すると、「オブジェクトが必要です」と怒られてしまいます。

 これは2つの間違いがあるのでわかりにくいのですが、一つずつ解消します。

 まず1点目
 それは「売上」には何もkeyが追加されていない状態で、「東京」のkeyを呼び出そうとしているからです。
 「東京」のkeyが入っているのは、あくまで「地区」ですので、まずは売上にkeyを追加しなければいけません。

 次に■のコメントアウトを外して実行してください。
 またまた同じところでオブジェクトがありませんと言われます。
 それは売上に(東京)を追加しましたが、Itemはあくまで文字列ですので、Addメソッドは使えません。

 Dim 売上東京 As String
 売上東京.Add "トマト" ,0

 はだれが見たってできませんよね?

 ですので、売上(東京)には新しく辞書オブジェクトをItemに入れてあげる必要があるのです。

 では次の説明です。
 ●のコメントアウトを外し、■をコメントアウトしてください。

 Stopまで処理が終わったら、F8を押してループが始まらずに処理が終了することを確かめてください。
 再度Stopまで処理をしたら、今度は変数kにカーソルをあわせてください。
 Emptyになっていませんか?

 次のコードを実行してください。
    Sub for足し算()
        Dim i As Long
        Dim 合計 As Long
        For i = 1 To 10
            合計 = 合計 + i
        Next i
        Debug.Print i
    End Sub
 イミディエイトウィンドウに「11」と表示されましたか?
 iは10までのはずなのに、11になってしまいました。
 それはiが加算された後に評価され、ループするか判断しているためです。
 わかりやすくDoLoopで再現すると
    Sub loop足し算()
        Dim i As Long
        Dim 合計 As Long
        Do Until i > 10
            合計 = 合計 + i
            i = i + 1
        Loop
        Debug.Print i
    End Sub
 このように処理していると考えられます。

 ですので、地区のForEachの外に変数kを置くと、千葉と東京のあとは空っぽですのでEmptyとなり、
 地区(Empty)はEmptyを返し、Split(Empty,Chr(2))は空っぽの配列となりループを抜けます。
 これらはコードをStopで止まったところで、イミディエイトウィンドウで以下のように手打ちすると
 わかります。(?も入力してください)

 ?isempty(地区(empty))
  出力結果→ True

 ?ubound(split(empty,chr(2)))
  出力結果→ -1 (配列0のこと)

 これでご理解いただけますでしょうか?
(稲葉) 2014/09/19(金) 23:24

おはようございます、ろでますです。
稲葉様、コメントありがとうございます。

まだ、マクロの実行を試みてはいませんが、なるほどとは思いました。

ちょっと、この連休の間に、間が悪く風邪を引いてしまい、今日は午後から帰るので、ちょっと今日中にマクロの実行&理解&コメントができるかどうかは、わかりません。

明日になるかもしれませんのでご了承ください。

すいませんがよろしくお願いいたします。
(ろでます) 2014/09/24(水) 07:53


おはようございます、ろでますです。
とりあえずご報告ですが、2つ目のマクロまでは無事動作した(と思います)。
ちょっと、数が多いので、debug.printでやると結構な数になるので、正確な数が連想配列に格納されているかどうかまでは確認していませんが、一つ確認すると正確な数が代入されていたので、おそらく問題なく動作していると思います。

稲葉様から頂いた丁寧なご解説で、理解したうえで動作できたことは、非常にありがたいです。

あとは、この連想配列に入れた値を、実際にシートに展開するマクロを、やはり稲葉様から頂いたマクロを理解しながら実施に取り組んでいこうと思います。

また、理解ができないところ等ございましたら、何卒よろしくお願い申し上げます。
(ろでます) 2014/09/25(木) 09:18


こんにちわ、ろでますです。
度々、ご報告になりますが、とりあえずすべてうまくいきました!。

以前ご教授いただいたファイルを開くのプロセスから、それらのデータを新しいワークシートに合算して出力することができました。

ロケーションが東京だけ解析の場合や、四半期や単月のみの解析等のパターンもうまく動作しました。

ひとまず、やりたいことの8割がたは完成したことをご報告と、御礼を申し上げます。

(ろでます) 2014/09/25(木) 16:29


こんにちわ、ろでまうです。
後だしじゃんけんみたいになってしまい、誠に申し訳ありませんが、稲葉様から頂いたマクロをベースに作ったのですが、以下のような表も必要になりました。まず表の方を表現させていただきます。
                [1]               [2]             [3]
[A]	   ボールペン	   サインペン	   その他
[B]7月東京
[D]7月千葉			
[E]8月東京
[F]8月千葉
・
・
・

のような表です。
月毎に、それぞれの売り上げを積み上げグラフとして表現する必要が生じたためです。(無論以前お伺いした、東京毎、千葉毎も必要なのですが、それに合わせて、これも必要になってしまった次第です)

とりあえず、2〜3日自分で何とかならないかを、試行錯誤していました。
稲葉様から、月毎に集計するマクロの方も使ってみて、両方を独立させて動作させてみたのですが、うまくいきませんでした。

これは、以前稲葉様から頂いた連想配列を2次元から3次元にすればいける?とも考えたのですが、どうにもやり方がわかりません。(そもそもの考え方自体が間違っている可能性も大です)

本当に今回はこれのみに、かなり時間を割いて(丸3日程)割いて試行錯誤したのですが、どうにもこうにも手詰まりしてしまいました。

度々のご無理なご質問ばかりで申し訳ありませんが、何卒ご教授の方いただけませんでしょうか。
(ろでます) 2014/09/30(火) 12:28


すいません、追記ですが。
積み上げグラフは、
「7月売売上」「8月売上」・・・が横軸になり、縦軸は売上件数。
そして、積み上げが東京と千葉に分かれる次第です。

すいませんが、何卒アドバイスのほどをよろしくお願い申し上げます。
(ろでます) 2014/09/30(火) 12:39


こんにちわ、ろでますです。
自レスに対するレスですが、どうも上記のようなグラフは、エクセルでは作成できそうにないですね・・・。
何か別のアプローチを考えます。
(ろでます) 2014/09/30(火) 14:57

 積み上げグラフは、 
       [A]      [B]         [C]     [D]
 [1]                        東京    千葉
 [2] 7月     ボールペン      10      60
 [3]         サインペン      20      50
 [4]         その他          30      40
 [5] 8月     ボールペン      40      30
 [6]         サインペン      50      20
 [7]         その他          60      10
 こんなデータ配置で描くと

  80

  70
       □  □  □  □  □  □
  60   □  □  □  □  □  ■
       □  □  □  □  ■  ■
  40   □  □  □  ■  ■  ■   □千葉
       □  □  ■  ■  ■  ■    ■東京
  20   □  ■  ■  ■  ■  ■
       ■  ■  ■  ■  ■  ■
   0 │ボ サ そ│ボ サ そ│
     │| イ の│| イ の│
     │ル ン 他│ル ン 他│
     │ペ ペ  │ペ ペ  │
     │ン ン  │ン ン  │
     │   7 月   │   8 月  │
 こんなグラフが描けますが。
 
(HANA) 2014/09/30(火) 15:38

こんにちわ、ろでますです。
HANA様、誠に有益な情報ありがとうございます!。
こんな方法があったとは、Google先生でいろいろ調べていたのですが、この方法は全く調べられませんでした。
誠にありがとうございます。

・・・しかし、これをマクロで可能にすることを考えると・・・もう、はっきりいって、ちんぷんかんぷんですね。

とりあえず頭をひねりまくって考えますが、何か有用なアドバイスなどありましたら、是非ともお願い申し上げたいです。

これが出来れば、このスレッドと、前のファイルオープン・クローズのスレッドも含めて完成します。
しかし、考えただけで、今のこの問題が一番難しそうな気がしてなりません・・・。
(ろでます) 2014/09/30(火) 16:52


 何をマクロにしないといけないのですか?

 表さえできれば、グラフ自体はマクロの記録でコードを取得して
 範囲を可変にすれば良さそうに思いますが。

 表を作る問題であれば、インプットを教えてみてもらえたらと思います。
  
(HANA) 2014/09/30(火) 17:04

こんにちわ、ろでますです。
>HANA様
はい、グラフ化自体はできると思います。
マクロの記録を使えば可能であると考えています。
問題は、データベースファイルから、このグラフの元となる表を作成するところにあります。
ちなみに、今の状態ですが、親マクロと子マクロの関係は以下のようになっています。
簡略して書きますが

Sub 売上高集計

    Dim ColResult1 , ColResult2 as Boolean
    Dim 月別 as String

    ThisWorkbook.Worksheets("Sheet1").Activate
    月別=Range("A1")

    If 月別 = "しない" Then
        ColResult1 = Application.Run("売上高取得1", OPN)
    Else
        ColResult2 = Application.Run("売上高取得2", OPN)
    End If
End Sub

このような関係になっており、月別というのは「する」と「しない」をドロップダウンリストで選択できるようにしており、「しない」場合は、このスレッドで既にご教授いただいた方法で、
「東京売上高」
「千葉売上高」
あと
東京と千葉を合算した表を作りグラフ化するのは成功しています。(詳しくは、このスレッドの上位側の稲葉様のコメントを参照して頂ければ、大変親切に解説いただいて、私も理解させていただきました)

出来ていないのは「する」にした場合の

        ColResult2 = Application.Run("売上高取得2", OPN)
のFuncton関数が今のところ全く思いつかない次第です。(というかグラフ化できることを今しがた知ったので、それをマクロで組むなど、今考えだしたところです)

インプットに関しては、ちょっと今から出ますので、明日以降にでもコメントさせて頂きます。

本当に、一から人に頼りっぱなし状態になってしまい、本当に申し訳ございませんが、何か良いアドバイスがございましたら、是非ともお願い申し上げます。
(ろでます) 2014/09/30(火) 17:18


 >本当に、一から人に頼りっぱなし状態になってしまい
 1)自分でまずやってみる
 2)分からないことを聞く
 3)理解しようとする
 これをしようとしない人にはここまで説明しません。
 というか大抵の人は求めたい結果が得られれば満足して内容を理解しようとしません。

 1・2は正直回答者にとっては手間(インプットとアウトプットだけ分かれば、自分で組んだ方が
 早い)ですが、いずれ質問者が回答者として戻ってきてくれることがひそかな楽しみです。

 で、本題です。
 >出来ていないのは「する」にした場合の 
 >ColResult2 = Application.Run("売上高取得2", OPN)
 >のFuncton関数が今のところ全く思いつかない次第です。
 これはHANAさんの2014/09/30(火) 15:38投稿で提示された表を作る、ということでいいんですかね?

 ということは、月And地区別ということ?

(稲葉) 2014/10/01(水) 09:57


おはようございます、ろでますです。

>これをしようとしない人にはここまで説明しません。
>というか大抵の人は求めたい結果が得られれば満足して内容を理解しようとしません。
>いずれ質問者が回答者として戻ってきてくれることがひそかな楽しみです。

私も、いずれ回答者となれるよう理解を必ずしつつ、マクロを組むことに心がけています。
そのため、私のコメントに多大な時間をかけていただき、稲葉様や他コメントいただいた皆様には迷惑をおかけしてしまい、申し訳ない気持ちと、逆に感謝に気持ちでいっぱいです。

>これはHANAさんの2014/09/30(火) 15:38投稿で提示された表を作る、ということでいいんですかね?

はい、ほぼその通りですが、若干簡素なものになります。

       [A]      [B]         [C]     [D]
 [1]                        東京    千葉
 [2] 7月     ボールペン      10      60
 [3] 8月     ボールペン      30      40

このように、種類は「ボールペン」一種類だけで結構です。(もちろんサインペンや、その他も別ブックで作ります)
今回は、それぞれ(ボールペン・サインペン等)を一つのブックで見えるようにしたいが為です。
つまり、出来上がったブックは、例として
「ボールペン第一四半期売上高.xlsx」

「サインペン第一四半期売上高.xlsx」
のようになります。

表のイメージは、HANAさんから頂いたものより簡素になり、以下の様になります。

  80

  70  
       □   □
  60   □   □
       □   □
  40   □   □   □千葉
       □   ■    ■東京
  20   □   ■
       ■   ■
   0 │ボ │ボ │
     │| ││ │
     │ペ │ペ │
     │ン │ン │
     │7月 │8月│

私自身、「簡単にできそうだ」と思っていたのですが、非常に浅はかな考えだったと痛感しています。
フロー的な考えなのですが、以前教えていただいた考え方だと
おそらく、
CreateObject("Scripting.Dictionary")
を3次元の連想配列にして
例えば
「7月」の「東京」の「ボールペン」
の数を連想配列に代入すればできるのかな・・・と考えたりもしていますが・・・。
その問題の「マクロの作り方」つまりインプリメントのしかたが理解(正直わからない)のです。

今私の頭の中の状況はこのようになっています。
いつもご迷惑をおかけいたしますが、アドバイスのほどを何卒よろしくお願い申し上げます。
(ろでます) 2014/10/01(水) 11:23


こんにちわ、ろでますです。
HANA様 >表を作る問題であれば、インプットを教えてみてもらえたらと思います。

インプットですが、まずデータベースファイルがあります。
これは、例えば第二四半期ですと
「H26-7月東京売上高.xlsx」
「H26-8月東京売上高.xlsx」
「H26-9月東京売上高.xlsx」
「H26-7月千葉売上高.xlsx」
「H26-8月千葉売上高.xlsx」
「H26-9月千葉売上高.xlsx」
という形になっており、それぞれのファイルにはCountifs関数でボールペンやサインペン、その他の売上高を集計した結果が、特定のセルに入っていると考えてください。
例として
Sheet1のRange("A1")には、同じくSheet1に記載されているデータベースからCountifsで集計したボールペンの売上高結果。(Countifsを使っている理由は、ボールペンの売上高でも、返品などがあればそれを差し引いたりしないといけないためです)
Sheet1のRange("B1")にはサインペンの売上高結果。
Sheet1のRange("C1")にはその他の売上高結果。
が入っているとお考えください。

ちなみに、
>ColResult2 = Application.Run("売上高取得2", OPN)
のOPNには、以前別スレッドで教えていただいた、コレクションを使ってのファイルを開いて、その一覧を配列に入れる方法で、以下のように渡されます。
OPN(1)=H26-07月東京売上高.xlsx
OPN(2)=H26-08月東京売上高.xlsx
OPN(3)=H26-09月東京売上高.xlsx
OPN(4)=H26-07月千葉売上高.xlsx
OPN(5)=H26-08月千葉売上高.xlsx
OPN(6)=H26-09月千葉売上高.xlsx
として、variant型の配列として渡しています。

インプットは以上のようになります。

申し訳ありませんが、良いアドバイス等おございましたらよろしくお願い申し上げます。
(ろでます) 2014/10/01(水) 11:48


 すみません。
 >>表を作る問題であれば、インプットを教えてみてもらえたらと思います。 
 と書いて、説明までいただいたのですが
 稲葉さんが降臨して下さった様ですので
 そちらで話を進めてもらえるのが良いと思います。

 ただ、ボールペンしかないなら

  70  
       □   □
  60   □   □
       □   □
  40   □   □   □千葉
       □   ■    ■東京
  20   □   ■
       ■   ■
   0 │7月 │8月│
 的なグラフで良さそうに思います。

 元データが		
		東京	千葉
	7月	10	60
	8月	30	40
 の様になるので、X軸とY軸を指定してやらないといけなくなるかもしれませんが。
  
(HANA) 2014/10/01(水) 16:06

 なんだか神々しくなりましたが>降臨
 昇天しないよう頑張ります!

 決められた形にするということは、集計と違い順番がかなり重要になってきますよね?
 OPNに入れる順番はろでますさんの方でお願いします・・・
 それから「特定のセル」も分からないと組めませんよね?
 項目名もループで出来る範囲はした方がいいと思います。(A列が数量でB列が項目名など)
 作成したコードはこのような表を読み取るものです。
	[A]	[B]
[1]	83	その他
[2]	55	その他
[3]	50	ボールペン
[4]	99	サインペン

 出力結果は次の通りです。
 新しいブックを作って、種類をシート名に入れています。
	[A]	[B]	[C]
[1]		東京	千葉
[2]	04月	27	90
[3]	05月	75	69
[4]	06月	66	50
 \その他/\ボールペン/\サインペン/

 ちょっと自分自身勉強中なので、ついでにお付き合いください!
 まずクラスモジュールをApplication.Run先のブックに追加してください。
 オブジェクト名を「cls表作成」としてください。

    '==============================================================================
    'クラスモジュールを追加して、オブジェクト名を「cls表作成」にしてください
    Option Explicit

    Private TblFormat
    Private Keys As Object
    Private Result As Collection
    Private Items As Collection
    Private SizeOffset As Collection
    Private 空間 As Long
    Private FLG As Boolean

    Private Sub Class_Initialize()
        Set Items = New Collection
        Set SizeOffset = New Collection
        Set Result = New Collection
        Set Keys = CreateObject("Scripting.dictionary")
        Items.Add CreateObject("Scripting.Dictionary"), "Record"
        Items.Add CreateObject("Scripting.Dictionary"), "HeadItem"
        ReDim TblFormat(1 To 1, 1 To 1)
        SizeOffset.Add UBound(TblFormat, 1) + 1, "Record"
        SizeOffset.Add UBound(TblFormat, 2) + 1, "HeadItem"
        空間 = 1
        FLG = False
    End Sub
    Private Sub Class_Terminate()
        Set Items = Nothing
        Set SizeOffset = Nothing
        Set Keys = Nothing
        Set Result = Nothing
        ReDim TblFormat(0)
    End Sub

    '//メソッド
    Public Sub SetHeadItem(ParamArray 項目())
        If FLG Then MsgBox "アイテム追加後はレコードと項目は編集できません": Exit Sub
        Call Setting(項目, "HeadItem")
    End Sub
    Public Sub SetRecord(ParamArray レコード())
        If FLG Then MsgBox "アイテム追加後はレコードと項目は編集できません": Exit Sub
        TblFormat = Application.Transpose(TblFormat)
        Call Setting(レコード, "Record")
        TblFormat = Application.Transpose(TblFormat)
    End Sub
    Public Sub Add(ByVal Key As String, ByVal 項目 As String, ByVal レコード As String, ByVal アイテム As Variant)
        FLG = True
        Dim tbl
        If Not Items("Record").exists(レコード) Then MsgBox レコード & ":存在しないレコードです": Exit Sub
        If Not Items("HeadItem").exists(項目) Then MsgBox 項目 & ":存在しない項目です": Exit Sub
        If Keys.exists(Key) Then
            tbl = Result(Key)
            Result.Remove Key
        Else
            tbl = TblFormat
            Keys.Add Key, ""
        End If
        tbl(Items("Record")(レコード), Items("HeadItem")(項目)) = アイテム
        Result.Add tbl, Key
    End Sub

    '//プロパティ
    Public Property Get ToArray(ByVal Key As String) As Variant
        ToArray = Result(Key)
    End Property
    Public Property Get CountR(ByVal Key As String) As Variant
        CountR = UBound(Result(Key), 1)
    End Property
    Public Property Get CountC(ByVal Key As String) As Variant
        CountC = UBound(Result(Key), 2)
    End Property
    Public Property Get GetKeys() As Variant
        GetKeys = Keys.Keys
    End Property

    '//クラス内関数
    Private Sub Setting(ByVal D As Variant, ByVal SetTo As String)
        Dim x, msg As String
        msg = ""
        ReDim Preserve TblFormat(1 To UBound(TblFormat, 1), 1 To UBound(TblFormat, 2) + (UBound(D) + 1))
        With Items(SetTo)
            For Each x In D
                If .exists(x) Then
                    msg = msg & "," & x
                    Exit For
                Else
                    .Add x, .Count + SizeOffset(SetTo)
                    TblFormat(1, .Count + 空間) = x
                End If
            Next x
            ReDim Preserve TblFormat(1 To UBound(TblFormat, 1), 1 To .Count + 1)
        End With
        'If msg <> "" Then MsgBox msg & "は既に追加されたアイテムです"
    End Sub    '==============================================================================

 次に標準モジュールに以下のSubとFunctionを追加してください。
    '==============================================================================
    Option Explicit
    Sub test2()
        Dim OPN(1 To 6)
        OPN(1) = "H26-04月東京売上高.xlsm"
        OPN(2) = "H26-05月東京売上高.xlsm"
        OPN(3) = "H26-06月東京売上高.xlsm"
        OPN(4) = "H26-04月千葉売上高.xlsm"
        OPN(5) = "H26-05月千葉売上高.xlsm"
        OPN(6) = "H26-06月千葉売上高.xlsm"
        種類別月毎売上高集計 (OPN)
    End Sub
    Sub 種類別月毎売上高集計(ByVal OPN)
        Dim 表 As cls表作成
        Set 表 = New cls表作成
        Dim 月地区, FN

        '//フォーマットの作成
        With 表
            For Each FN In OPN
                Set 月地区 = GetString(FN)
                .SetHeadItem 月地区(1)
                .SetRecord 月地区(0)
            Next FN
        End With

        '//データの登録
        For Each FN In OPN
            Set 月地区 = GetString(FN)
            With Workbooks(FN).Sheets("Sheet1")
                表.Add Key:=.Range("B1"), 項目:=月地区(1), レコード:=月地区(0), アイテム:=.Range("A1").Value + .Range("A2").Value
                表.Add Key:=.Range("B3"), 項目:=月地区(1), レコード:=月地区(0), アイテム:=.Range("A3").Value
                表.Add Key:=.Range("B4"), 項目:=月地区(1), レコード:=月地区(0), アイテム:=.Range("A4").Value
            End With
        Next FN

        '//データの出力
        Dim 種類
        With Workbooks.Add
            For Each 種類 In 表.GetKeys
                With .Sheets.Add(after:=.Sheets(.Sheets.Count))
                    .Name = 種類
                    .Range("A1").Resize(表.CountR(種類), 表.CountC(種類)).Value = 表.ToArray(種類)
                End With
            Next 種類
        End With
    End Sub
    Private Function GetString(ByVal FN As String) As Variant
        With CreateObject("VBScript.RegEXP")
            .Pattern = "-(\d{2}月)(\W+)売上"
            If .test(FN) Then
                Set GetString = .Execute(FN)(0).submatches
            Else
                Set GetString = Nothing
            End If
        End With
   End Function   
    '==============================================================================

 必要なファイルを開いて、Test2を実行してください。    
 フォーマットのクリアとか他にも追加したいところですが、時間が無かったので
 とりあえずここまで・・・
 まず実行してもらって、分からないところがあれば聞いてください。

(稲葉) 2014/10/01(水) 17:55


おはようございます、ろでますです。
>なんだか神々しくなりましたが>降臨

確かに、マクロを見せていただくと、かなり神々しいですね!
私も、理解しながら頭がパンクしないように頑張ってみます。

とりあえず、いまから理解をしていこうと思いますので、わからないところがありましたらよろしくお願い申し上げます。
(ろでます) 2014/10/02(木) 09:50


こんにちわ、ろでますです。
今回はかなりややこしいので、手順とフローを逆にして理解したいと思います。
まず、それぞれのプロシージャーが何をしているのかを理解した上で、フローを理解したいと思います。

まず最初のクラスのイニシャライズプロシージャーから理解したいと思います。
そもそものこのイニシャライズイベント(初期化)が発生するのは、後の
sub 種類別月毎売上高集計 (byval OPN)
内の
set 表 = cls表作成
が実行された際にこのイニシャライズが走ると理解しました。
後はそれぞれのコードごとに理解したいと思います。

   Option Explicit

'変数宣言

    Private TblFormat
    Private Keys As Object
    Private Result As Collection
    Private Items As Collection
    Private SizeOffset As Collection
    Private 空間 As Long
    Private FLG As Boolean
'変数宣言はここまで

    Private Sub Class_Initialize() '特殊イベントのイニシャライズの宣言
        Set Items = New Collection 'Itemsの実態を作成
        Set SizeOffset = New Collection 'SizeOffsetの実態を作成
        Set Result = New Collection 'Resultの実態を作成
        Set Keys = CreateObject("Scripting.dictionary") '連想配列Keysを作成(中身はまだ空)
        Items.Add CreateObject("Scripting.Dictionary"), "Record"
        Items.Add CreateObject("Scripting.Dictionary"), "HeadItem"
    'この上の2行がまず理解しづらい点です。
    'Itemsはコレクションなので、後ろ側の "Record"と"HeadItem"はキーだと理解します。
    'しかしながら、「値」が「CreateObject("Scripting.Dictionary")」だと値に何が入っているのかがわかりません。

        ReDim TblFormat(1 To 1, 1 To 1) 'TblFormatの配列宣言(0を使わない2次元配列)
        SizeOffset.Add UBound(TblFormat, 1) + 1, "Record" 'コレクション「SizeOffset」に多次元配列TblFormatの1次元目+1の値、つまり「2」が値で、キーが「Record」の値を追加
        SizeOffset.Add UBound(TblFormat, 2) + 1, "HeadItem"
'上記と同じで、キーだけが「HeadItem」になる。
        空間 = 1 '空間を1で初期化
        FLG = False 'FLGの初期状態は「False」
    End Sub

とまず理解をしました。
理解できない2行の部分と、理解間違いがある部分があればご指摘のほどをよろしくお願い申し上げます。
(ろでます) 2014/10/02(木) 14:11


こんにちわ、ろでますです。
自分に対するレスですが
>今回はかなりややこしいので、手順とフローを逆にして理解したいと思います。
>まず、それぞれのプロシージャーが何をしているのかを理解した上で、フローを理解したいと思います。

と、思っていましたが、やはり先にフローを理解しないと何をしているかが理解できないですね。
すいませんが、少しずつ聞かせて下さい。
一部を理解しないと、次が理解できないためです、申し訳ありません。

まず、フローとして、

        With 表
            For Each FN In OPN
                Set 月地区 = GetString(FN)
                .SetHeadItem 月地区(1)
                .SetRecord 月地区(0)
            Next FN
        End With
の部分ですが、
表.SetHeadItem⇒クラスメソッドのSetHeadItem⇒クラス内関数のSetteingというフローをたどっていると思いますが、概要で結構ですので、これが「何をしているのか」だけでも良いので教えていただけませんでしょうか。
何をしているかがわかれば、マクロの内容自体はGoogle先生やヘルプなどにまず聞いてみてから、自分で理解できるよう努力します。

何卒よろしくお願い申し上げます。

(ろでます) 2014/10/02(木) 16:35


 わからないところ以外は完璧ですよ!
 これ理解するのは相当苦労すると思いますが、cls表作成を「そういうことができるオブジェクトなんだ」
 と理解してもらって納得していただたほうがいいかもしれません。

 簡単な仕様と概念の説明です。
	[A]	[B]	[C]
[1]		項目1	項目2
[2]	レコード1	アイテム1-1	アイテム1-2
[3]	レコード2	アイテム2-1	アイテム2-2
[4]			

 同じ項目、同じレコードを複数表、準備することに特化したオブジェクトだとご理解ください。
 今回は種類ごとに同じフォーマットの表を作成しますので、最初のにフォーマットとなる2次配列を準備しま
 した。
 Settingはそのフォーマットとなる配列を作成するプロシージャになります。

 項目はItemsコレクションのHeadItemキーとRecordキーにそれぞれDictionaryオブジェクトを入れて重複が
 無いようにそれぞれ追加できます。

( 稲葉) 2014/10/02(木) 17:26


こんばんわ、ろでますです。
>稲葉様
とりあえず、頂いたマクロをF8キーでポチポチ押しながら、ローカルウィンドで変数の流れなどを確認しています。
理解には相当時間がかかりそうですが、ご了承ください。
あと、若干の手戻りが発生してしまいました。
というのは、以前稲葉さまから教えていただいたファイルオープンの手法ですが、動的変数をあらかじめ1番から使うという
「Option Base 1」
を入れていなかったので、OPNが0スタートになり、結果OPN(0)にはEmptyが入っていたため、私のほうのマクロに、稲葉様から今回いた空いたマクロを変数名等を変更して動作させた場合、
>.SetHeadItem 月地区(1)
のところでエラーが発生してしまいました。
ですので、まずOPNを1からにする変更をしているのですが、どうせやるならば、ユーザにファイルが入っているフォルダを選択してもらい、そのフォルダの中にあるファイルを、例えば第一四半期だと
H26-4月東京売上高.xlsx



H26-07月千葉売上高を一気に読み込むように変更を考えています。
いっぺんに2つのことを同時にやるなと申し上げられるかもしれませんが、例ととしてあげると、例えば地域が3つ、これを年単位での売上高を集計しようとすると、ユーザーはデータベースのファイルを36個選んで開かなければなりません。
これでは非常にユーザビリティが悪いなと考え、今回の考えにいたったため、このように仕様を変更しようかと考えています。
やり方は、稲葉様から教えていただいた連想配列とCreateObject("VBScript.RegEXP")を駆使すれば何とかできるのではないかと、現在取り込んでいるところです。

ここでもつまってしまうかもしれませんが、その節は何卒ご教授のほどをよろしくお願い申し上げます。
会社情報を自宅には持ち帰ることができないので、土日は作業ができませんので、申し訳ありませんが次のコメントは月曜日以降にさせていただきます。

ご迷惑ばかりおかけして本当に申し訳ありませんが、今後とも何卒よろしくお願い申し上げます。
(ろでます) 2014/10/03(金) 23:42


こんにちわ、ろでますです。
すいません、ちょっと手戻してしまうのですが、ご質問させてください。
これまでに教えていただいた方法と、Google先生などに質問して
・フォルダから一気にフォルダ内のファイル一覧を抜いて、配列に入れる。
・正規表現で必用なところを抜き出す。
という作業まではできました。

しかしながら、そこから必要なファイルだけを開く方法が思いつきません。
例えば、フォルダに
2013-12月千葉売上高.xlsx
2014-04月東京売上高.xlsx
2014-05月東京売上高.xlsx
2014-06月東京売上高.xlsx
2014-07月東京売上高.xlsx
ゴミ.xlsx
というファイル一覧が存在して、(以前年のところは和暦でしたが、和暦だと変わった時に使えなくなりそうなので、ファイル命名規則を西暦に変更しています)
これがOPN(1)〜OPN(6)に入っているします。
これを、ドロップダウンリストでユーザが選択した、年、年度(月)、地区を開こうとした場合、
例えば、ユーザが「2014」年の、「第一四半期」の「東京」をドロップダウンリストから選択した場合、開くファイルは、
2014-04月東京売上高.xlsx
2014-05月東京売上高.xlsx
2014-06月東京売上高.xlsx
だけでなくてはなりません。

これをするにはどうすればよろしいでしょうか。
簡単そうに考えていたのですが、思いつきません・・・。
ちなみに、今抜き出しですが以下のようにマクロを組んでおり、変数「年」「月」「地区」は抜き出せている状態です。

   Select Case True
        Case 解析月 = "年"
            初月 = "1"
        Case 解析月 = "年度"
            初月 = "4"
        Case 解析月 = "第一四半期"
            初月 = "4"
        Case 解析月 = "第二四半期"
            初月 = "7"
        Case 解析月 = "第三四半期"
            初月 = "10"
        Case 解析月 = "第四四半期"
            初月 = "1"
        Case 解析月 = "上半期"
            初月 = "4"
        Case 解析月 = "下半期"
            初月 = "10"
        End Select

'ファイルのオープン

    With CreateObject("VBScript.RegEXP")
        For Each BN In OPN
            If .test(BN) Then
                .Pattern = "(.+)(\D+)(\d+)(月)(\W+)(売上高)": .Global = True
                年 = .Execute(BN)(0).submatches(0)
                月 = .Execute(BN)(0).submatches(2)
                月 = CLng(月)
                Debug.Print 月
                地区 = .Execute(BN)(0).submatches(4)
            End If
        Next BN

ここで、必要なファイルを開いて、開いたファイルを稲葉様に教えていただいたクラスモジュールのところに渡せれば、何とかなりそうだと思っています。

手戻になってしまい、誠に申し訳ございませんが、ご教授のほどを何卒よろしくお願い申し上げます。
(ろでます) 2014/10/06(月) 14:45


すいません、先のレスへの自己追加レスです。
解析年は、ワークシートのSheet1のRange("C3")に入っており、変数「解析年」に格納してあります。
解析月はワークシートのSheet1のRange("D3")に入っており、変数「解析月」に格納してあります。
地区は、ワークシートのsheet1のRange("B3")に格納されてます。
ただし、地区については、「全ロケーション」というものがドロップダウンリストから選択できるようになっており、その場合は、ワークシートのSheet2にドロップダウンリストの元となるリストが、B行に格納されており、そこには

    B
1 全ロケーション
2   東京
3   千葉
4   横浜
5    ・
6    ・

の様に入っており、全ロケーションが選択された場合は、配列「ロケーション()」にここに書かれた、東京・千葉・横浜・・・の様に、配列に1番から格納されています。

なお、地区として東京を仮に選択した場合は、配列ロケーション(1)に地区の「東京」が入るようになっています。

何卒アドバイスのほどをよろしくお願い申し上げます。
(ろでます) 2014/10/06(月) 15:31


 15:31のコメント読んでないです。
 たたき台だけ準備しますので、後は自分で考えてみてください。
 それに関しては
 (ご近所PG) 2014/09/17(水) 18:12
 の投稿が既にありますので、参考にしてください。
 どうもユーザーフォームからどう選択させたいのか分かってないので、回答の要領得ないって感じです。

 ユーザーフォームはこんな感じ?
 ┌────────────┐
 │集計年度:2014年度  ▼│ 
 │集計期 :第一四半期 ▼│ ←ここに「年、年度、半期・・・」等選択させる
 │集計地区:東京    ▼│
 └────────────┘

 フォルダ構造がこう?
 フォルダ内に年度、地区、月問わず保存されている
 データフォルダ
 ├2013-12月千葉売上高.xlsx 
 ├2014-04月東京売上高.xlsx 
 ・・・・以下省略

 で本題ですが
 名前の付け方が決まっていること 保存されているフォルダが決まっていること
 でしたら、このようにファイル名を作ってしまう方法はいかがでしょうか?
        Sub 期()
            Dim 期 As String
            Dim 地 As String
            Dim 年度 As Long
            Dim 解析月
            期 = "年"
            地 = "東京"
            年度 = 2014

            Select Case 期
                Case "年":         解析月 = 月設定(12, 1, 地, 年度)
                Case "年度":       解析月 = 月設定(12, 4, 地, 年度)
                Case "第一四半期": 解析月 = 月設定(3, 4, 地, 年度)
                Case "第二四半期": 解析月 = 月設定(3, 7, 地, 年度)
                Case "第三四半期": 解析月 = 月設定(3, 10, 地, 年度)
                Case "第四四半期": 解析月 = 月設定(3, 1, 地, 年度)
                Case "上半期":     解析月 = 月設定(6, 4, 地, 年度)
                Case "下半期":     解析月 = 月設定(6, 10, 地, 年度)
            End Select
        End Sub
        Function 月設定(ByVal 期間 As Long, ByVal 開始月 As Long, ByVal 地区 As String, ByVal 年度 As Long) As Variant
            Dim 基準 As Date
            Dim tmp, i As Long
            Dim WSF As WorksheetFunction
            Set WSF = Application.WorksheetFunction
            ReDim tmp(1 To 期間)
            基準 = CDate(年度 & "/" & 開始月 & "/1")
            For i = 1 To 期間
                tmp(i) = Format(WSF.EoMonth(基準, i - 1), "yyyy-mm月") & 地区 & "売上高.xlsx"
            Next i
            月設定 = tmp
        End Function

(稲葉) 2014/10/06(月) 15:38


こんにちわ、ろでますです。
ファイルのフォルダ指定での方は理解&マクロの作成も完了しました。(頂いたサンプルマクロからいろいろ修正や、理解すべきところもあったので少々時間がかかってしまい申し訳ございません)

Callでのファイル名の引数渡しも正常に完了し、これで、クラスモジュールの方に専念できます。

>稲葉様
クラスモジュールの方をポチポチとF8を押しながら、動作を確認しているですが、やはりといってはなんですが、なかなか理解ができません。
やはり、動作フローがわかっていないことには、サンプルマクロ自体を頂いても、それが何を意味しているのか、つまり、各Subモジュールの意味(このSubモジュールは何々をしている等)と、フローチャート(流れ)を簡単で結構ですのでご教授いただけませんでしょうか。(初期化と終了(end sub)部くらいでしたら理解できるのですが・・・(情けない・・・)

マクロの構文自体はGoogle先生に聞けば分かると思います。

ご無理ばかりを申し上げまして誠に申し訳ございませんが、何卒よろしくお願いできませんでしょうか。

ちなみに、OPNに正しい値でファイル名を渡して、マクロ自体をそっくりそのままコピペして動かして確認しているのですが、

For Each FN In OPN

     Set 月地区 = GetString(FN)
     With Workbooks(FN).Sheets("Sheet1")
     表.Add 種類:=.Range("B1"), 項目:=月地区(1), レコード:=月地区(0), アイテム:=.Range("A1").Value + .Range("A2").Value
     表.Add 種類:=.Range("B3"), 項目:=月地区(1), レコード:=月地区(0), アイテム:=.Range("A3").Value
     表.Add 種類:=.Range("B4"), 項目:=月地区(1), レコード:=月地区(0), アイテム:=.Range("A4").Value
     End With
Next FN
の
     With Workbooks(FN).Sheets("Sheet1")
のところで、F8をポチット押すと、なぜか、
終端のクラスモジュール
Private Sub Class_Terminate()
に飛んでしまい、結果としてEnd Subになり、マクロがそこで、Call元のマクロに戻ってしまいます。

申し訳ありませんが、アドバイスのほどを頂けましたら、よろしくお願い申し上げます。
(ろでます) 2014/10/08(水) 11:21


とりあえず、ここまでは把握できた(かもしれない)というところだけ書いてみます。
        Dim 表 As cls表作成
        Set 表 = New cls表作成 'クラスモジュールの初期設定(初期値の代入・つまり設計図の作成?)
クラスとは何かという部分から勉強しています。
http://www.excellenceweb.net/vba/class/what_vba_class.html
を参考にしています。
ここで、
「クラスとは、オブジェクトの設計図やひな形にあたるものです」
とあります、つまり
Private Sub Class_Initialize()
は設計図の作成を意味していると理解しています。

そこでわからない点というか、それぞれが何をするためにどういった設計図を組んでいるのかという意味を理解するためには、それぞれの変数が何を意味するのかをまず知る必要があると思います。
つまり具体的にいうと

        Set Items = New Collection
        Set SizeOffset = New Collection
        Set Result = New Collection
        Set Keys = CreateObject("Scripting.dictionary")
        Items.Add CreateObject("Scripting.Dictionary"), "Record"
        Items.Add CreateObject("Scripting.Dictionary"), "HeadItem"
        ReDim TblFormat(1 To 1, 1 To 1)
        SizeOffset.Add UBound(TblFormat, 1) + 1, "Record"
        SizeOffset.Add UBound(TblFormat, 2) + 1, "HeadItem"
        空間 = 1
        FLG = False
でどういった設計図を描いているのかという点がまず最初に最も重要な点だと考えます。
そういった意味で、
この中の各変数が何を意味しているのか(何をしているのかは理解できても、何を意味しているのかが理解できません)を理解しないと、その後の動作は全く理解できないと私なりに考えています。

申し訳ございませんが、そういった意味でのアドバイスを何卒お願い申し上げます。
その上で、先に私が書きましたフローの把握ができれば、何が悪いのか、なぜ動かないのかなどが理解できてくると思います。

何卒よろしくお願い申し上げます。

(ろでます) 2014/10/08(水) 11:51


 >With Workbooks(FN).Sheets("Sheet1")
 ここでクラスオブジェクトがリリースされることはないと思うのですが・・・
 再現出来ないので、ここのコードのとき、ファイルが開かれているか、
 On Errorルーチンは閉じられているか(呼び元で宣言したまま呼出すと、エラーの時点で元のプロシージャに戻る)
 私が提示した呼び元のコードでは問題なく実行できるか確認してください。

 >「クラスとは、オブジェクトの設計図やひな形にあたるものです」
 >とあります、つまり
 >Private Sub Class_Initialize()
 >は設計図の作成を意味していると理解しています。
 違います。 クラス自体が設計図です。 作成しているのはプログラムを書いた人です。

 イニシャライズは実体化した時に呼び出されるイベントなだけで、クラス内で必要な変数宣言や
 メソッドやプロパティーの記述が簡単になるような処理をしているだけに過ぎません。

 ホームセンターのDIY製品を例にすると、
 無限に在庫がある商品に(メモリの限りインスタンスを生成出来る)
 宛先を書いて(変数に実体化)
 棚から取り出し、配送します(イニシャライズ)
 消費者は届いた荷物を組み立てて(Add などのメソッド)
 お皿や本をしまいます(プロパティー Let)
 後で分かりやすいようにインデックスもつけます(プロパティー Get)
 不要になったら指定した方法で廃棄します(ターミナイズ)
 こんな感じです。

 フローとか書いたことないので分かりませんが・・・
 少し分かりやすく説明出来るように考えてみます。 

(稲葉) 2014/10/08(水) 13:27


こんにちわ、ろでますです。

> On Errorルーチンは閉じられているか(呼び元で宣言したまま呼出すと、エラーの時点で元のプロシージャに戻る)
>私が提示した呼び元のコードでは問題なく実行できるか確認してください。

すいません、おっしゃるとおりでした。
呼び出し元で、IF文の中にOn Error Goto 0 を入れる必要があり、入れていたのですが、条件判定でそちら(On Error Goto 0がある方)の条件に飛ぶと、問題なく動作するのですが、ない方に条件分岐した場合、End ifの後ろに「On Error Goto 0」を入れていませんでした。
結果、おっしゃる通り、元にルーチンに戻っていました。

ですので、End ifの後に「On Error Goto 0」を入れると、
With Workbooks(FN).Sheets("Sheet1")
のところでエラーで止まりました。
そして、よくよくか考えると、とても単純なエラーでした。

わたしはOPNのファイル、例えば「2014-04月東京売上高.xlsx」のShee1にはワークシート名を入れてあります。(これまでSheet1と書いていたのは、会社情報を公の場で書けないため、あくまでSheet1と読み替えて提示しておりました)
なので、ここは、
With Workbooks(FN).worksheets("「ワークシート名」")
としないからエラーが出たようです。(と推測というか、たぶんそうなんだと思います)

で、ここをデータベース用のシート名を入れると問題なく動作しました。
しかしながら、次に

        With Workbooks.Add
            For Each k In 表.GetKeys
                With .Sheets.Add(after:=.Sheets(.Sheets.Count))
                    .Name = k
                    .Range("A1").Resize(表.CountR(k), 表.CountC(k)).Value = 表.ToArray(k)
                End With
            Next k
        End With
の
.Name = k
のところでエラーが出ます。
エラー内容は「アプリケーション定義またはオブジェクト定義エラーです」とでます。

フローが理解ていない現状で、何が悪いのかわからないため、検証として
H26-04月東京売上高.xlsm
H26-05月東京売上高.xlsm
H26-06月東京売上高.xlsm
H26-04月千葉売上高.xlsm
H26-05月千葉売上高.xlsm
H26-06月千葉売上高.xlsm
の中身は空のエクセルブックを作成し、開いた状態で、稲葉様から頂いたマクロを実行しても同様のエラーが発生しました。

この部分は、マクロを見て、動きと憶測で書いてしまいますが、新たにフォーマットを作成したデータの出力部分だと認識しています。

現状でこの様な憶測でしかまだ話せる理解度しか持っていない自分が情けないのですが、いったい何が悪いのでしょうか。
稲葉様のエラーが出ない環境と、私のエラーが出る環境では何が違うのでしょうか。

申し訳りませんが、何か良いアドバイスがあればよろしくお願い申し上げます。
(ろでます) 2014/10/08(水) 15:46


 自作クラス云々は置いといて、以下のコード部分だけを見て判断できる事は
 
        With Workbooks.Add
            For Each k In 表.GetKeys
                With .Sheets.Add(after:=.Sheets(.Sheets.Count))
                    .Name = k
 
追加したシートの名前を変数【k】に入っている名称にしようとしてるんだな。
そこでエラーが出るって事はシート名に使えない内容が【k】に入ってるんじゃないかな。
変数【k】の中身を調べてみよう。
 
ですかね。
(ご近所PG) 2014/10/08(水) 16:17

 ターミナイズってなんだ・・・ターミネイトの間違いです。

 まず15:45の返信
 ご近所PGさんフォローありがとうございます!
 まさにその通りです!

 ろでますさん  
 ご近所PGさんの投稿前に作った文章ですので、読み飛ばしてもらった構いません。
 質問かかれるときは、変数の中身見てください。
 「k」は空っぽになっていませんか?

 2014/10/01(水) 17:55の投稿で、サンプルデータを提示しました。
 >の中身は空のエクセルブックを作成し
 当たり前ですよね?

 試しに新しいブックを開いて、イミディエイトウィンドウに
 sheets("Sheet1").name = ""
 と入力して実行してください。
 同じエラーになります。 つまりシート名は空白ではいけないのです。

 ではなぜ「k」は空白なのでしょうか?
 ここで「フローが分からない」と聞かれればお答えできます。

 似たようなエラーですが、↓はシート名に使用できない文字を入力しようとした場合です。
 sheets("Sheet1").name = "/"
 自分で実行して確かめてみてください。

 15:45分終り
 =========================

 フローを文章に直すのは無理でした。
 コードがフロー見たいなものなので、一々説明出来ません。
 分からないところだけ聞いてください。

 考え方だけ。
 ちなみに、標準モジュールのプロシージャではなく、かなり強引に作っているので、
 とりあえず動けばいいや位で考えてもらえればありがたいです・・・
 クラスモジュールなんて作らなくても、普通のプロシージャ内で完結することも出来ますが、
 制御系と操作系は分けてもいいかなと言う単純な理由で作ったものです。

 説明の前にモジュールレベル変数とプロシージャレベル変数ってご理解頂いてます?
 ご理解頂いていること前提で。

 【目的】
 同じ形の表に、値だけ違うものを、種類の数だけ作りたい

 【手段】
 種類の数 = Resultコレクションに、種類のキーを当てて、アイテムにtblを入れる
 値だけ違うもの = tblにTblFormatをコピーして、項目とレコードに当てはまる行列に値を入れる
 同じ形の表 = ファイル名から地名と月を取り出して、TblFormatの1行目、1列目にそれぞれいれ、
         Itemsコレクションに入れた、HeadItemとRecordのキーを持つDictionaryオブジェク
         トに順序を入れる

 それぞれ必要な数だけクラス内のモジュールレベル変数にコレクションなどの実体を与えてあげる
 (イニシャライズ)

 【使い方】
 SetHeadItemメソッド 共通テーブル(TblFormat)に項目名(1行目)を追加する(重複は無視される)
 SetRecordメソッド 共通テーブル(TblFormat)にレコード名(1列目)を追加する(重複は無視される)
 ↑提示したサンプルでは、Forで回していますが、引数をカンマで区切れば配列として渡せます。

 Addメソッド
  種類 ・・・表の題名。既に存在する種類ならば項目とレコードと一致するところに上書きされる。
        存在しなければ新しい表を作成する
  項目 ・・・項目名を指定する。どの項目に追加するか文字で指定する。
        存在しない場合は無視される。
  レコード・・レコード名を指定する。どのレコードに追加するか文字で指定する。
        存在しない場合は無視される。
  アイテム・・追加するアイテムを文字又は数値で指定する。先で指定した項目名、レコード名が
        交わるところにアイテムを追加する

 ToArrayプロパティ 
  種類 ・・・指定した種類の表を配列として出力する。

 CountR、CountCプロパティ
  種類 ・・・指定した種類の最終R=行、C=列を数値として出力する

 GetKeysプロパティ すべての種類を配列として出力する

 使っているものはこのくらい。
 各メソッド(Sub)の仕組みや考え方は、既にご説明した内容とほぼ同じですので割愛します。
 真新しいステートメントやオブジェクト等使っていませんよね?
(稲葉) 2014/10/08(水) 16:28

>ご近所PG様
>稲葉様
こんにちわ、ろでますです。

稲葉さんから頂いた詳しいご説明の理解は明日になります(すいません)

確かに、変数kの値は空白になっていました。
なぜ空白なのかをkを逆読みのフローで考えていきました。
かなり間違っているかもしれません。あと、後半から理解できませんでした。

まず、kがワークシート名
それはクラスモジュール(オブジェクトと考えてよろしいのでしょうか)のGetKeysのプロパティである。
GetKeysプロパティのの中身は
Keysの
Keysプロパティである。

しかし、Keysは最初のイニシャライズで連想配列にしているだけ・・・
じゃあ、どこでKeysが設定されているの?

これが今の私の頭の中です。

すいません、ちょっと時間の関係で稲葉様からの詳細内容を理解せずに書いています。
もし、「コメントの内容を理解すればわかるよ」というのであれば、申し訳ありません。

その場合は、この私のコメントは忘れていただいて、スルーしてください。

よろしくお願い申し上げます。
(ろでます) 2014/10/08(水) 17:23


 稲葉さん向けに、ちょろっとコメントです。
流れをぶった切ってるのは承知で、ちょっとだけ。
本筋からは外れたものとみてすっ飛ばして良いです。
ひょっとするとろでますさんの疑問にも効果があるかもしれません。
 
 > GetKeysプロパティ すべての種類を配列として出力する
 
「GetKeys」で「種類」が返ってくるという事が、
プロパティ名やメソッド名だけで判断しづらく感じます。
それがこのクラスを使おうとする人(あるいは読み解こうとする人)の混乱の元になっているのかな
と感じられました。
 
「Key = 種類」だと分かっている人であれば混乱も少ないでしょうけれど、
「GetKeysの中身は種類のリストが入ってるんだよ」という事を誰が見ても分かる様にすると
設計者以外の人でも利用しやすくなると思えます。
 
例えば
プロパティ名を「GetKeys」ではなく「Get種類s」だとか「Get種類List」みたいな名前にしちゃう。
そうすると利用するときに
    For Each k In 表.GetKeys
                       ↓
    For Each k In 表.Get種類s
    For Each k In 表.Get種類List
というコードになって、kの中には「種類」が入ってくるんだな、とコードの見た目だけで分かる。
 
あるいは逆で、
そもそもAddするところで「種類」という変数名を使わずにただ「Key」としてしまう。
そうすると利用するときに
    表.Add 種類:=.Range("B1"), 項目:=月地区(1), レコード:=月地区(0), アイテム:=.Range("A1").Value + .Range("A2").Value
            ↓
    表.Add Key:=.Range("B1"), 項目:=月地区(1), レコード:=月地区(0), アイテム:=.Range("A1").Value + .Range("A2").Value
というコードになって、
「GetKeys」が返すのは「Key」だろうから、さっきAddするときに設定した「.Range("B1")」に入ってた値が返るんだな、
と、利用する人の中で繋がる。
これはもし仕様が変わって、ユニークキーが「種類」以外になった時にも、変数の意味が破綻しなくなる。
 
もう一つ
現状そのままのプロパティ名でやるなら、サンプルコードで
        Dim k
        With Workbooks.Add
            For Each k In 表.GetKeys
                With .Sheets.Add(after:=.Sheets(.Sheets.Count))
                    .Name = k
と記述してた部分を
        Dim 種類
        With Workbooks.Add
            For Each 種類 In 表.GetKeys
                With .Sheets.Add(after:=.Sheets(.Sheets.Count))
                    .Name = 種類
としてあげると、読みやすくなるかなとは思いました。(ここはあえての部分?かしれないけど)
(ご近所PG) 2014/10/08(水) 17:27

 ご近所PGさん
 ご指摘ありがとうございます。
 3点のご指摘とも、おっしゃる通りでこちらは私の怠慢ですね・・・
 私も勉強中の身ですのでご意見ありがたいです。

 結合度(と言っていいのか)を低くするためにも、
 Addのプロパティは第一引数はKey
 GetKeysはそのまま
 For Eachの周りは「種類」と表現してあげた方が親切ですね。

 それからItemsのところは、ArrayListを入れて、IndexOfメソッドでもいいのかなとか
 後で見るとほんとに分かりにくいですね・・・

 クラスの中身を見直して分かり安く作り直してみます。

 ありがとうございました。

 ろでますさん、分かり難くてすみません。

(稲葉) 2014/10/08(水) 18:00


 ろでますさん
 ご指摘いただいたところを修正して、
 2014/10/01(水) 17:55に投稿したコードを修正しました。
 ご確認ください。

 >しかし、Keysは最初のイニシャライズで連想配列にしているだけ・・・ 
 Addメソッド内で
 Keys.Add Key, ""
 ちゃんと中身入れてますよ!
(稲葉) 2014/10/08(水) 18:17

こんにちわ、ろでますです。
たくさんのコメントありがとうございます!。
しかし、やはり理解、解読していこうとすると、私のスキルではとても難しいです。

イニシャライズのところだけでも、2時間かかって、以下の様に理解しました(本当に精一杯です)
ローカルウィンドで確認しながら、確認していきました。

とりあえず、小出しになっていき申し訳ありませんが、私の理解が合っているかをご確認願います。
少なくとも問題の変数kのところまでは理解をしたい(すべきだ)と思っています。
まずイニシャライズのところから

    Private Sub Class_Initialize()
        Set Items = New Collection
        Set SizeOffset = New Collection
        Set Result = New Collection
        Set Keys = CreateObject("Scripting.dictionary")
        Items.Add CreateObject("Scripting.Dictionary"), "Record"
        '上で定義したコレクションに以下の値を入れる。
    'インデックス(1) ITEMは未定義の連想配列(?) キーは"Recoad"
        Items.Add CreateObject("Scripting.Dictionary"), "HeadItem"
    'インデックス(2) ITEMは未定義の連想配列(?) キーは"HeadIem"
        ReDim TblFormat(1 To 1, 1 To 1)
    '2次元配列 TblFormatの初期値。TblFormat(1,1)
        SizeOffset.Add UBound(TblFormat, 1) + 1, "Record"
    '上で定義したコレクションに以下の値を入れる。
    'インデックス(1) ITEMはTblFormatの一次元目+1(2) キーは"Recoad"
        SizeOffset.Add UBound(TblFormat, 2) + 1, "HeadItem"
    'インデックス(2) ITEMはTblFormatの二次元目+1(2) キーは"HeadIem"
    'ItemsとSizeOffsetはキーは同名だがコレクション名が違うため、同じに見えて、実は全くの別物。当然、Itemsコレクションのキー"Record"で、SizeOffsetのインデックス(1)にはアクセス不可。    
        空間 = 1
        FLG = False
    End Sub

いかがでしょうか。

本当に初心者で申し訳ありません。
(ろでます) 2014/10/09(木) 12:01


 イニシャライズはただの実体化宣言で、何も処理していません。

 後ろから見た方が理解し易いと思います。
 例えば

 ToArrayに種類を渡すと、表が出力できる
  →じゃあToArrayプロパティは何をしているんだろう?
   Resultコレクションに種類を渡している
   →Resultコレクションはどこで表を作っているのだろう?
    Addメソッドで登録している
     ↓
 表オブジェクトにAddメソッドでKey、項目、レコード、アイテムを渡すと、特定の項目・レコードの
 組合せにアイテムが登録出来る
  →どうやって登録しているのだろう?
   KeysにKeyがあるか調べている
    →Keyは何だろう
     種類を登録している
   KeysにあったらtblにResult(Key)を渡して、そのキーを消している
    →なぜだろう? 
     ●こういうところは聞いてください
   Keysになかったら、tblにTblFormatを渡して、Keysにキーを渡している
    ◆Keysは種類をしまうオブジェクトなんだ!
   tblにデータを移したら、Itemsコレクションのアイテムをtblの引数にしている
    Itemsコレクションの中身は何だろう?
     ↓

 Set〜〜では項目とレコードを登録している
  →はしょるけど、TblFormatの
   項目番号   → Items("HeadItem")コレクションに、項目キーと列番号のアイテム
   レコード番号 → Items("Record")コレクションに、レコードキーと行番号のアイテム
   をそれぞれ登録している。

 ▲結論
 つまり、Items("HeadItem")に項目名を渡すと、項目が登録されている列番号が返ってくる
 ということは、tbl(行番号,列番号)を呼出て、アイテムを登録しているんだ。
 それを、Resultに種類のキーを渡して、登録したtblを丸ごとアイテムに入れているんだ
 だから、Resultに種類のキーを渡すとtblが帰ってくるんだ

 分かりにくいコードですが、そこまで難しいことをしているわけではないので、これ以上概念を
 聞かれても答えようがありません。
 各コードの処理は何のためにやっているの?とかそういった質問でお願いします。
(稲葉) 2014/10/09(木) 13:43

こんにちわ、ろでますです。
稲葉様の、13:43のコメントを見ずに書いたコメントなので、場違いならばそのままスルーしてください。

とりあえず、ループの1週目を理解すれば、それ以降も理解できると思うので、ポリポチとF8とローカルウィンドを確認しながら、理解しようとしています。色々飛んでいくので細切れで書いてしましますが、ご容赦願います。

申し訳ありませんが、理解できているかどうかのチェックをお願い申し上げます。

        Dim 表 As cls表作成
        Set 表 = New cls表作成 '前レスで書いたクラスモジュールの値の初期値代入
        Dim 月地区, FN

        '//フォーマットの作成
        With 表
            For Each FN In OPN
                Set 月地区 = GetString(FN) 'GetStringへ飛び(引数はOPN(1)のファイル名全体)、variant型配列、月地区(1)には地区、(0)には月が入る。[1]へ飛ぶ。
                .SetHeadItem 月地区(1) 'クラスモジュールのSetHeadItemへ飛ぶ。[2]へ飛ぶ。

[1]

    Private Function GetString(ByVal FN As String) As Variant
        With CreateObject("VBScript.RegEXP")
            .Pattern = "-(\d{2}月)(\W+)売上"
            If .test(FN) Then
                Set GetString = .Execute(FN)(0).submatches 'submatchesしたすべてのItemをvariant型の配列GetStringに返す。1週目なので、Item(1)は04月、Item(2)は東京
            Else
                Set GetString = Nothing
            End If
        End With
   End Function

[2]

    Public Sub SetHeadItem(ParamArray 項目()) '項目()は最初は月地区(1)=東京の引数が入る。分からない点は、「ParamArray」で配列渡しをしているのかという点。(Byvalだとなぜ駄目なのか)
        If FLG Then MsgBox "アイテム追加後はレコードと項目は編集できません": Exit Sub
        Call Setting(項目, "HeadItem") 'クラス内関数Setting[3]へ飛ぶ。引数は最初なので項目=東京と第二引数として、"HeadItem"。

[3]非常に理解しづらい関数がここです。ここを理解できれば・・・と思っています。

    '//クラス内関数
    Private Sub Setting(ByVal D As Variant, ByVal SetTo As String)
        Dim x, msg As String
        msg = ""
        ReDim Preserve TblFormat(1 To UBound(TblFormat, 1), 1 To UBound(TblFormat, 2) + (UBound(D) + 1)) 'ここが理解できがたい点です。2次元配列の再定義というのは分かりますが、何を、何のために再定義しているのかがわかりません。
        With Items(SetTo) 'with以降コレクションItemsの"HeadSet"へアクセスすると宣言
            For Each x In D 'ワークブックxからOPN(1)までループ宣言
                If .exists(x) Then '1週目なので、xは空なのでElseへ飛ぶ
                    msg = msg & "," & x
                    Exit For
                Else
                    .Add x, .Count + SizeOffset(SetTo) '1週目なので、コレクションItemsのインデックス(1)のItemに空白を代入、キーは、Itemsの連想配列の初期値がEmptyなので、これにSizeOffsetの初期値2が加算され、2.
                    TblFormat(1, .Count + 空間) = x '二次元配列TblFormat(1,3)が""(空白)になる。
                End If
            Next x
            ReDim Preserve TblFormat(1 To UBound(TblFormat, 1), 1 To .Count + 1) 'ここが理解できがたい点です。2次元配列の再定義というのは分かりますが、何を、何のために再定義しているのかがわかりません。

        End With
        'If msg <> "" Then MsgBox msg & "は既に追加されたアイテムです"

以上です。

正直言ってだから、この関数が何をしているの?といわれると分かりません・・・
が、中身の理解が合っており、この関数が何をしているのかがわかれば、次に進めると思っています。
何卒ご指導のほどをよろしくお願い申し上げます。
(ろでます) 2014/10/09(木) 14:37


こんにちわ、ろでますです。
稲葉様のコメントを頂いて、全体像として4割くらいは理解できたと思います。

エラーも回避して、無事動作することを確認しました。
完全に理解するのはこれからになりますが、とりあえず動いたことに対しまして、コメントいただいた皆様に深く感謝の意を評したいと思います。

本当にありがとうございます!。

しかし、私自身・・・こういった言い方はあまり好ましくはありませんが・・・、「能力不足」ですね。

すぐさま答えを返していただける皆様と比べて自分自身の未熟さを本当に痛感させられました。そのために皆様、特に稲葉様に多大な時間と稼働を割いていただいたことに深くお詫びしたいと思います。

これからも、VBAは仕事で欠かせないものになってきます。
このスレッドで学んだことを無駄にしないためにも、日々研鑚を重ねたいと思います。

誠に申し訳ございませんでした。
(ろでます) 2014/10/09(木) 15:50


 どこを深く読み解けば良いか、その勘を得るには経験をつんでいくしか無いかなと思います。
勘だとアレか。
「自分ならどういうものを作るだろう?こう作るかな?」っていう作り手の視点。
それがあると読み解き易くなるかなぁ、と思います。
 
簡単にですが、先に私が示した「k」の中身について、
ろでますさんと同じ視点(提供されたクラスを利用する)にいる私が調べようとするならこんな手順かな?
と言うのを何かの参考になるかもしれないと思い書いてみます。
 
kには何が入るんだろう?
 ↓
GetKeysの中身を順に処理してるんだな、じゃあGetKeysって何を返すのかな?
 ……GetKeysの「Get|Keys」ここらにキャレットを移動して「Shift+F2」、あるいは右クリックから「定義」を選択
 ↓
クラスのGetKeysプロパティの定義にとんだ。
どうやらKeys.Keysを返してるだけだ。
 ↓
Keysってなんだ?どこで定義されている?
 ……Keys.Keysの「Ke|ys.Keys」ここらにキャレットを移動して「Shift+F2」、あるいは右クリックから「定義」を選択
 ↓
Private Keys As Object を確認。
どうやらモジュール変数として宣言されているようだ。これがセットされているのはどこ?
 ……キーワード「Keys」でモジュール内を検索
 ↓
Private Sub Class_Initialize()
    Set Keys = CreateObject("Scripting.dictionary")
を確認。
イニシャライズでDictionaryをセットしてるのね。
次を検索しよう。
 ↓
Private Sub Class_Terminate()
    Set Keys = Nothing
を確認。
ターミネートで開放ね。
次を検索しよう。
 ↓
Public Sub Add(ByVal Key As String, ByVal 項目 As String, ByVal レコード As String, ByVal アイテム As Variant)
   〜
        Keys.Add Key, ""
を確認。
 
どうやら「Add」で「Key」(以前は「種類」という変数名だった)を追加してるようだ。
じゃあ「Add」した時に第一引数に指定したものが入ってるんだな。
ここには何を設定してやるんだったかな。
 
 
……みたいな。
(ご近所PG) 2014/10/09(木) 16:27

 TblFormatはその名の通りフォーマットです。
 宣言したばかりのTblFormatをセルに表すとこんな感じです。
 	[A]
[1]	

 東京を追加すると
	[A]	[B]
[1]		東京
 こうなります。

 4月を追加すると
	[A]	[B]
[1]		東京
[2]	04月	
 こうなります。
 どのくらい大きい表になるか分かりませんので、追加される度に大きくします。

 最初のReDimは渡された配列分大きくします。
 最後のReDimは重複して追加されなかった項目もあるので、実際に追加された配列のサイズに
 戻しています。

 で、ReDimの制約で、最後の次元しか増やせない決まりになっています。
 例えば↓の表のまま、行方向に大きくしようしても出来ません。
	[A]	[B]
[1]		東京
[2]	04月	
[3]	05月 ←エラーでサイズを増やせない

 ですので、Settingで呼出す前にTransposeでさかさまにしてあげます。
 そうすれば最後の次元に月が来ますので、追加出来るようになります。
	[A]	[B]	[C]
[1]		04月	05月
[2]	東京		

 >分からない点は、「ParamArray」で配列渡しをしているのかという点。(Byvalだとなぜ駄目なのか)
 ByVal? 参照渡しの事を言いたいのですか?

 ParamArrayにした理由は、このクラスの性質上、項目名は複数のシートまたはブックに渡っているか、
 または既に決められた項目名かのどちらかに偏ると考えたからです。

 前者の場合、1つずつ登録する。 後者の場合まとめて登録出来るって感じでいいかなーと思いまして。
 Variant型でもよかったとは思いますが。
 なので余り気にしないでください。
(稲葉) 2014/10/09(木) 17:01

 こんにちは。横から失礼します。

 うえのほうでクラスはオブジェクトか?という質問があったかと思いますが、そのとおりです。
 あ、わたしのはなしは基本「おおざっぱ」なので、大まかに言えばとご理解ください。

 で、オブジェクト=クラス ということなので、ワークシートとかセルとかもクラスです。
 こういったクラスのクラスモジュール(に相当するもの)はマイクロソフト社のプログラマさんが
 書いています。ユーザーは、モジュールの中を見ることはできません。
 ひたすら プロパティとメソッドを操作することでオブジェクトを操作します。

 ユーザーの立ち位置で クラスを外側から見てみるのも、クラスを理解するひとつのアプローチです。
 どんなプロパティがあるか、型はなにか、値の代入もできるのか、読み取りのみか
 どんなメソッドがあるのか、それを実行すると何が起こるのか。
 外側から見たクラスの属性とふるまい、ですね、これを調べます。
 内部のコードを知らなくても セルを理解するというのはあるわけで。
 クラスモジュール内部の理解と二本立てです。 

 > 「能力不足」ですね。 
 実力以上のことにがんばって取り組んでおられるからですよ。
 どんな上級者でも、実力以上のことに取り組めば「能力不足」です。
 だいじょうぶです。

 ただ、あまりにもしんどいようならギブ・アップされてもいいかも知れません。
 背伸びをすればギリギリ手が届くくらいがの難易度が 実力アップにはちょうど良いと
 聞きます。

( 佳 ) 2014/10/09(木) 20:18


こんにちわ、ろでますです。
本当に、一歩進んでは三歩下がるみたいな感じですいません。

クラスモジュールの件は、皆様のコメントを参考に今後努力して理解していきます。

逆にいうと、以前教えていただいた連想配列については大分理解できて、実用的に使おうとしています。

ここで、申し訳ないのですが、再度連想配列に関して質問があります。
今回は例えば
「4月の東京の売上高」・・・
ということです。
つまり、連想配列にすべきは
売上高(4月)(東京)=売上高の実際の値
という2次元配列になります。

以前教えていただいたのは1次元だったと思うのですが、今回は2次元だと思います。
そうなってきたときに、実際の売上高は以下のように入れることが可能だと思います。

        Set 月地区 = CreateObject("Scripting.Dictionary")
        With CreateObject("VBScript.RegEXP")
            .Pattern = "(.+)(\D+)(\d+)(月)(\W+)(売上高)"
            For Each BN In OPNOpen
                Workbooks(BN).Worksheets("Sheet1").Activate
                If .test(BN) Then
                    月 = .Execute(BN)(0).submatches(2)
                    月地区.Add 月, CreateObject("Scripting.Dictionary")
                    地区 = .Execute(BN)(0).submatches(4)
                    月地区.Item(月).Add 地区, Range("A1")
                End If
            Next BN

これで、各月の場所に関しての、実際の売上高を、連想配列「月地区(月)(地区)=売上高(数字)」を代入することができます(実際できました)
問題は、これを展開する方法に関してご質問させてください。
Keysプロパティで参照すると思うのですが、2次元の場合はどのように参照すればいいのでしょうか。

      dim i,k

            For Each i In 月地区(i)(k).Keys
                For Each k In 月地区(i)(k).keye
                    Debug.Print 月地区(i)(k)
                Next k
            Next i

のようなマクロを組んでみたのですが、どうもうまく動作しませんでした。
本当にひとつ教えてもらったら、手戻してしまうというのは、情けない話ですが、何卒ご教授のほどをお願い申し上げます。
(ろでます) 2014/10/10(金) 17:27


 連想配列以前の問題です。

 >dim i,k
 >For Each i In 月地区(i)(k).Keys
           ~~~         ~~~
 iは別の変数で使っていますよね?

 For Each k In 月地区(i)(k).keye
                            ~~~~
 Keysの間違い?

 あと2次元配列とはちょっと違います。
 1次元でキーを持つ配列が2つです。
 Dictionaryなどで2次元として扱っているものと、通常の配列で2次元の違いは、
 前者は2列(KeyとItem)しかないシートを複数用意するようなイメージです。
 後者は1つのシートに入るイメージです。
 【Dicのイメージ】		
	[Key]	[Item]
[1]	東京	シート2参照
[2]	千葉	シート3参照
[3]	埼玉	シート4参照
[4]		

 シート2		
	[Key]	[Item]
[1]	07月	10
[2]	08月	20
[3]	09月	30
[4]		

 シート3		
	[Key]	[Item]
[1]	07月	40
[2]	08月	50
[3]	09月	60
[4]		

 シート4		
	[Key]	[Item]
[1]	07月	70
[2]	08月	80
[3]	09月	90
[4]		

 【通常の配列のイメージ】
	[A]	[B]	[C]	[D]
[1]		07月	08月	09月
[2]	東京	10	40	70
[3]	千葉	20	50	80
[4]	埼玉	30	60	90
[5]				

 つまりDictionaryはシートに出力するとき、まとめて出力することが出来ないので、
 一度通常の配列に入れ直す必要があります。

 一度に全部やろうとするのではなく、小さなプログラムを何度も何度も繰り返し組んで
 理解を深めてから見つめ直してください。
 佳さんもおっしゃっていますが、「背伸びをすればギリギリ手が届くくらい」のプログラム
 を何度も何度も書いてみてください。

 本気で理解したければ、「Dictionaryを使って、この表をこのような表に作り替えてください」
 見たいな問題をいくつか出しますので、それに回答してレベルアップを計るという手もあります。
 (それでも回答は千差万別でしょうけど)
 ↑の提案の場合、新しいスレッド作ったほうがいいでしょう。

(稲葉) 2014/10/10(金) 18:35


おはようございます、ろでますです。
丁寧なコメントをいつもありがとうございます。

連想配列の点については、せっかく教えていただいたのだから、使って少しでも自分のスキルアップ向上になればいいと思って、使ってみて・・・という背景でご質問させていただきました。

コメントいただいたからには、少しやり方を考えてみます。
その前に教えていただいたコレクションでも可能性を考えてみています。

とにかく、クラスモジュールに関しては理解がまだできていないのですが、今回皆様にご助力いただいたところを、自分の力で使いきれるようになって、そこが今の、「背伸びをすればギリギリ手が届くくらい」だとおもっています。

今は月中ということもあり、VBAに割ける時間は多くあります。
自分なりに精一杯がんばっているつもりではいます。

ただ、それが皆様のご負担や、ご気分を害されるようであれば、申し訳ありません、ごめんなさい、といわざるをえないことをご容赦ください。

ただ、これだけは一点。
私は社会人であり、また、会社の人間でもあります。
会社人として、命令に対し「No」はありません。
必ず結果を出すことが、会社人としての使命です。

ですので、自分なりに考えて考えて、それでも駄目な場合は、申し訳ありませんが、このようにまたご質問させていただくか、最悪「答えを教えてください」ということもあるかもしれません。

その際は、何卒、その状況というものを鑑みて、ご助力、アドバイスのほどをお願いしたいことを切に願います。
よろしくお願い申し上げます。
(ろでます) 2014/10/11(土) 08:23


 衝突。

 こんにちは。

 基本的過ぎて失礼かと思いますが、下記をしっかり認識する必要があります。
 エラーが出た場合は、どこでどんなエラーが出たのか、エラー番号とエラーメッセージ。
 (可能なら)なにがまずくてそのようなエラーになるのか。
 エラーが出ないなら、どのようにうまくいかないのかを詳細に正確に。
 (掲示板にいちいち書いていただく必要はありませんが、確実に確認してくださいね)

 > 「4月の東京の売上高」
 一度に答えを得ようとせず、ひとつひとつ段階を踏んで考えればできるはずです。
 売り上げを登録したときと同じルートをたどるのです。 

 まず 一つ目ディクショナリの 4月に対応するItemを取得するコードを書きます。
 取得したら変数Xにでも代入しましょうか。ここまでは書けますね、もちろん。
 変数Xはとうぜんディクショナリですから、これの東京に対応するItemを取得する
 コードを書きます。ここも書けるはずです。落ち着いてゆっくり書けば大丈夫です。
 取得したら、Debug.Printにでも出しましょう。

 

( 佳 ) 2014/10/11(土) 09:07


追記です。

会社への責任ということなら、
クラスも使わずディクショナリも使わないコードを別途用意して置かれ
たほうが安全です。いざ正解を希望されたときに、悪い風邪でも流行っ
ていて誰も回答できない可能性もゼロではありません。
逆に、コードがいただけてもあとのメンテができませんでは、会社に対
する責任を果たせたとはいえないと思います。

上記のようなワザを使うのは、コードをもっと良くするためです。
使わなくても要求を実現することはできます。

※クラスの勉強をギブアップすると書いたのは、クラスなしで済ませる
 という意味のつもりでした。

( 佳 ) 2014/10/11(土) 10:04


 んー目的が結果を出すことなのか、理解することなのかはっはっきりしてもらえません?
 もし結果だけ求めるならアプローチ変えます

 月毎、地区毎のブック分けを廃止して、全てひとつの表で管理します
 まずそこが原点だと思う

(稲葉) 2014/10/11(土) 18:48


こんにちわ、ろでますです。

>んー目的が結果を出すことなのか、理解することなのかはっはっきりしてもらえません?

基本は結果ですが、理解も必要です。
どっちもとらずにどちらかにしろと、というならば、結果です。

ただ、これ以外のマクロの部分で、これまで教えていただいたコレクションやディクショナリーや正規表現でのパターンマッチなどは活用してます。
これは、皆様から結果だけでなく、内容まで詳しく教えていただいた結果です。
これは、その場で結果だけを求めていてはできなかったことです。

そういう意味で、過程も重要です。
クラスモジュールの件についても、私は裏でもっと簡単なクラスモジュールを作って、どう動いているのかをもっと簡単なところから理解しようとしていま。

時間はあります。
時間はあるので、結果だけ「すぐ」求めたいわけではありません。

今回の、作成した表に、実際の値をデータベースから引っ張ってきて、作成した表の中のセルに入れるというのも、私の頭の中では簡単だと思っていました。
アプローチは以下の通りです。

1.まず仮に第一四半期で東京・千葉がある場合、データベースファイル(OPN)から、正規表現でそれぞれアクティベートする。
2.アクティベートしたデータベースファイルの「売上高」が書いてあるセルを変数に代入する。
3.この変数を、今度は表のファイルのそれぞれのセルに入れる。
4.その際の、どのセルに入れるかはFind関数を用いて、「1」の正規表現での引っ張ってきた(例としてあげるなら、4月の東京)の列番号と行番号を取得する。
5.この列番号と行番号のセルに値を代入する。

と考えていました。
しかし、これが実際のマクロで組もうとするとどうしてもうまくいかないのです。

なので、このアプローチが間違っているのか、もっと別の方法なのか(要は全くプログラマーとしての基本である、アプローチのしかたが全然違うのか)、それすらもわかりません。

なので、これまで、答えを先にある程度提示して頂いたうえで、それを理解しようとしている次第です。
この点は、ご理解ください。

その上で、今回は「結果」(答え)をください。
ただ、表作成までは、ここまでいただいたマクロの上で動くことがよいと考えています(せっかく教えていただいたことを無駄にしたくないとご理解ください)

私もマクロコードを数日考えた上でのことです。
分からないから、すぐに答えをくださいと言っているわけではないことを何卒ご理解いただきたいと思います。

本当に抽象的な発言と勝手なお願いとなってしまいますが、よろしくお願い申し上げます、
(ろでます) 2014/10/14(火) 12:41


 >1.まず仮に第一四半期で東京・千葉がある場合、データベースファイル(OPN)から、正規表現で
 >それぞれアクティベートする。 
 >(中略)
 >なので、このアプローチが間違っているのか、もっと別の方法なのか(要は全くプログラマーと
 >しての基本である、アプローチのしかたが全然違うのか)、それすらもわかりません。 
 プログラマーとしてでなく、データベースの有り方(考え方?)に問題があります。

 ろでますさんが描いた概略図に従って説明して参りましたが、
 通常(私なら)項目が決まっている表であれば一度一つの表にデータをすべてまとめます。
 そのデータを元に必要な情報を取り出す(ピボットテーブルやオートフィルタなど)操作をします。

 なのでファイル名をチェックして開いて変数にいれて・・・・
 なんてことやりません。
 なぜ今までそのことを説明しなかったのかと言うと、データについて説明が無かったこと。
 聞いてもセキュリティーがーって教えてくれなかったこと。
 質問内容が具体的に「こういう手順でやりたい」と決まっていたことです。

 本題ですが、順序立てて説明すると 
 1)特定のフォルダにあるデータをすべて開く(4半期とか関係なく全部開く)
 2)新しいブックに開いたブックの項目を入れる
 3)2のブックに、「地区」と「月」の2つの項目を追加する
 4)ブック毎の処理でデータを入れると同時に、ブック名から地区と月の項目を埋める
 5)すべてのデータを入れ終わったら必要な集計に応じてピボットテーブルや統合等で集計する

 1〜4をマクロで実施して、5は手作業にします。

 要は
 データベース知らないやつが集計なんて考えるな!
 エクセルの標準機能使えないやつがVBAいじるな!
 の2点ですかね?

 クラスモジュールは忘れて、新しいアプローチで進めませんか?(提案しておいてあれですが)
 前回の質問時もデータの形すら教えてもらえませんでしたが、今度こそ教えてください。

 ちなみに新しいアプローチはすべて今まで教えたコードで作成出来ます。
 時間があるなら、新しいアプローチで挑戦してみてください。

(稲葉) 2014/10/14(火) 13:01


こんにちわ、ろでますです。
稲葉様、この度は少々きついコメントでしたが、それも親切心と思ってお答えします。

> なのでファイル名をチェックして開いて変数にいれて・・・・
中略
>質問内容が具体的に「こういう手順でやりたい」と決まっていたことです。

すいません、私もプログラマーの端くれとしては、大筋のフローは決めていたので、それにのっとって作業をしていたので、細かいベースでの質問攻めになってしまったことは謝ります。

>データベース知らないやつが集計なんて考えるな!
>エクセルの標準機能使えないやつがVBAいじるな!

すいません、これは私にもいえることかとも思います。
確かに、標準機能を使って、手作業でやればすぐに終わる話です。

問題は、この機能を「データベースも、エクセルの標準機能も使えない人」達向けに作っていることです。
要は、「ボタン一つで、お前の作ったデータベースから、集計してグラフ化しろ!」と言われているが為です(私事情で誠に申し訳ございません)

>前回の質問時もデータの形すら教えてもらえませんでしたが、今度こそ教えてください。

データの形とはデータベースの形のことでよろしいですよね。
これはここで詳細をお伝えします。

基本的には、売上高は、詳細なデータベースから、同一シート状に展開した表にCountifsでまとめています。
以下のようになります
・ファイル名「2014-04月東京売上高.xlsm」、データベースはSheet2に「売上高」という名前を付けて保存
     A      B     C    D
1(表題) 品目    店名    額   販売日  
2   サインペン  渋谷店   100円   4/1
3   ボールペン  丸ノ内店  150円   4/2
4    消しゴム   千代田店  50円   4/2



このようなデータベースになっています。
これを同一シート上でCountifsを使い、更にBB列でSum関数でその月の売上合計をまとめています。

   R       X    Y  Z ・・・ BB
1         9/1  9/2  9/3  ・・・ 合計
2サインペン合計 100  500  200  ・・・ 10000
3ボールペン合計 150  450  150 ・・・ 12500
4その他合計    200  600  450 ・・・ 20000



10総計     15000  30000 20000 ・・・ 500000     

このような形です。
ファイル、「2014-05月東京売上高.xlsm」や「2014-06月東京売上高.xlsm」、「2014-04月千葉売上高.xlsm」・・・「「2014-06月横浜売上高.xlsm」というファイル名で、中身は全く同じデータベース様式となっており、どのデータベースでも抜いてくるデータのRangeはすべてRange("BB10")になります。

そして、抜き出すのが、このBB行の「合計」で、この合計を
先に提示して頂いた表
       A    B     C 
1      東京   千葉   横浜
2 4月  500000  350000  400000
3 5月  ・・・・
4 6月  ・・・・

という形にして、積み上げ型のグラフ化したいわけです。

これで、ご回答になっていますでしょうか。

もし、このDBからデータを抜いて新しいアプローチがあるのなら、そちらでチャレンジしたいと考えます。
なぜなら、これを使うものが「エクセルの全くのど素人」が使うことを想定して作っているためです。

以上が私のご回答になります。

稚拙なご回答ではありましたが、何卒よろしくお願い申し上げます。(すいません、プレビューでみると、行と列の組み合わせがバラバラで見にくいです・・・申し訳ないです)
(ろでます) 2014/10/14(火) 15:29


 >>データベース知らないやつが集計なんて考えるな! 
 >>エクセルの標準機能使えないやつがVBAいじるな! 
 >すいません、これは私にもいえることかとも思います。 
 >確かに、標準機能を使って、手作業でやればすぐに終わる話です。 
 これはろでますさんに向けた言葉です。
 VBAはエクセルの標準機能を使えることが強みです。
 ですので、エクセルの標準機能を知らずしてVBAを触っても、労多くして功少なしです。
 つまりVBAで標準機能が使えるような表を作成しなさい、必要があれば標準機能をVBAで
 使いなさい。
 うまく伝わってないようなので、もう一度言いました。

 1)ピボットテーブル(エクセル標準機能)を設定したテンプレート(エクセル標準機能)を準備する
 2)ピボットテーブルで集計したい形に合わせた表を作る(VBA)
 3)1をコピーして表範囲にデータを貼り付け、ピボットテーブルを更新する
 4)必要に応じて、テンプレートにマクロボタンでピボットテーブルのフィルタを変更するボタンでも
   付けてあげればいいじゃない。
   ついでにピボットグラフもおいておけば一石二鳥。
 これで何が問題あるのでしょう?

 表の整形例ですが

 東京04月							
	[A]		[B]		[C]	[D]			
[1]	品目		店名		額	販売日			
[2]	サインペン	渋谷 店	100円	4月1日			
[3]	ボールペン	丸ノ内店	150円	4月2日			
[4]	消しゴム 	千代田店	 50円	4月2日			
[5]	サインペン	丸ノ内店	100円	4月3日			
[6]	シャーペン	千代田店	150円	4月3日			

 千葉04月							
	[A]		[B]		[C]	[D]			
[1]	品目		店名		額	販売日			
[2]	ボールペン	我孫子店	150円	4月1日			
[3]	消しゴム	成田 店	 50円	4月2日			
[4]	消しゴム	木更津店	 50円	4月2日			
[5]	サインペン	野田 店	100円	4月3日			
[6]	ボールペン	酒々井店	150円	4月3日			

 まとめ							
	[A]		[B]		[C]	[D]	[E]	[F]	[G]
[1]	品目		店名		額	販売日	月	地区	集計項目
[2]	サインペン	渋谷 店	100円	4月1日	04月	東京	サインペン
[3]	ボールペン	丸ノ内店	150円	4月2日	04月	東京	ボールペン
[4]	消しゴム 	千代田店	 50円	4月2日	04月	東京	その他
[5]	サインペン	丸ノ内店	100円	4月3日	04月	東京	サインペン
[6]	シャーペン	千代田店	150円	4月3日	04月	東京	その他
[7]	ボールペン	我孫子店	150円	4月1日	04月	千葉	ボールペン
[8]	消しゴム	成田 店	 50円	4月2日	04月	千葉	その他
[9]	消しゴム	木更津店	 50円	4月2日	04月	千葉	その他
[10]	サインペン	野田 店	100円	4月3日	04月	千葉	サインペン
[11]	ボールペン	酒々井店	150円	4月3日	04月	千葉	ボールペン

 まとめのような表にして、ピボットグラフを挿入
 系列に地区、項目に月、レポートフィルタに品目、値に額
 グラフの種類を積み上げ棒グラフ (今回の例では4月しかないので一本の棒ですが)
 ではだめなんですか?

(稲葉) 2014/10/14(火) 16:17


こんにちわ、ろでますです。
コメントが大変遅くなって申し訳ございません。

桂様と稲葉様の言葉を受けて、頭を冷やして、冷静に考えてみました。
そうすると、
「なんだ、こんなに簡単に表も値の代入もできるじゃないか」
と気づきました。

稲葉様には申し訳ありませんが、以下の方法で表作成と値の代入、これを持ってのグラフ作成まで完成させました。
稲葉様の「一度ワークブックを開いて、ワークシートにコピーする」手法は使わせていただきました。

確かに、上手いマクロでもスマートでもありません。
でも、結果を出すことが目的なので、とりあえず以下で進めました。

表作成のマクロ

引数
解析月=上半期とか、第一四半期とか
エリア=全エリアなのか、東京だけなのかとか

Option Explicit
Option Base 1
Function 表作成(ByVal 解析月 As String, エリア As String) As String

    Dim i, ロケ数, maxrow As Long
    Dim ロケーション(), SaveFile As String
    Dim WB As Object
    Dim WSH, Path_Desk As Variant

    Set WSH = CreateObject("WScript.Shell")
    Path_Desk = WSH.SpecialFolders("Desktop") & "\"
    ChDir Path_Desk

    Set WB = Workbooks.Add
    WB.SaveAs Path_Desk & 解析月 & エリア & "売上高.xlsx"

    Select Case 解析月

        Case "第一四半期"

            Range("A2") = "04月"
            Range("A3") = "05月"
            Range("A4") = "06月"

        Case "第二四半期"

            Range("A2") = "07月"
            Range("A3") = "08月"
            Range("A4") = "09月"

        Case "第三四半期"

            Range("A2") = "10月"
            Range("A3") = "11月"
            Range("A4") = "12月"

        Case "第四四半期"

            Range("A2") = "01月"
            Range("A3") = "02月"
            Range("A4") = "03月"

        Case "上半期"

            Range("A2") = "04月"
            Range("A3") = "05月"
            Range("A4") = "06月"
            Range("A5") = "07月"
            Range("A6") = "08月"
            Range("A7") = "09月"

        Case "下半期"

            Range("A2") = "10月"
            Range("A3") = "11月"
            Range("A4") = "12月"
            Range("A5") = "01月"
            Range("A6") = "02月"
            Range("A7") = "03月"

        Case "上半期"

            Range("A2") = "04月"
            Range("A3") = "05月"
            Range("A4") = "06月"
            Range("A5") = "07月"
            Range("A6") = "08月"
            Range("A7") = "09月"

        Case "年度"

            Range("A2") = "04月"
            Range("A3") = "05月"
            Range("A4") = "06月"
            Range("A5") = "07月"
            Range("A6") = "08月"
            Range("A7") = "09月"
            Range("A8") = "10月"
            Range("A9") = "11月"
            Range("A10") = "12月"
            Range("A11") = "01月"
            Range("A12") = "02月"
            Range("A13") = "03月"

        Case "年"

            Range("A2") = "01月"
            Range("A3") = "02月"
            Range("A4") = "03月"
            Range("A5") = "04月"
            Range("A6") = "05月"
            Range("A7") = "06月"
            Range("A8") = "07月"
            Range("A9") = "08月"
            Range("A10") = "09月"
            Range("A11") = "10月"
            Range("A12") = "11月"
            Range("A13") = "12月"

    End Select

    Select Case エリア
        Case "全ロケーション"
            maxrow = ThisWorkbook.Worksheets("項目リスト").Range("B1").End(xlDown).Row - 2
            ReDim ロケーション(maxrow)
            For i = 1 To maxrow
                ロケーション(i) = ThisWorkbook.Worksheets("項目リスト").Cells(i + 2, 2)
            Next i

            For i = 1 To UBound(ロケーション)
                Cells(1, i + 1) = ロケーション(i)
            Next i
        Case Else
            Cells(1, 2) = エリア
    End Select
    表作成 = 解析月 & エリア & "売上高.xlsx"
End Function

値代入のマクロ

引数 MovBook=OPNからデータベース部分だけをワークシートにコピーしたブックの名前。
品目=売り上げ全体なのか、特定の品物なのか(例えばボールペンとかサインペンとか)
clsFile=上のマクロで作成した表のファイル名

Option Explicit
Option Base 1
Function 件数取得(ByVal MovBook As Variant, ByVal 品目 As String, ByVal clsFile As String) As Boolean

    Dim 月row, ロケcol, maxrow, maxcol As Long
    Dim 月, 地区, WS As Variant
    Dim rngFind As Object

    Workbooks(MovBook).Activate

    If 品目 = "売上全体" Then
        For Each WS In Worksheets
            Debug.Print WS.Name
            With CreateObject("VBScript.RegEXP")
                .Pattern = "(\d+)(月)(\W+)"
                If .test(WS.Name) Then
                    月 = .Execute(WS.Name)(0).submatches(0)
                    Set rngFind = Workbooks(clsFile).Sheets("Sheet1").Cells.Find(what:=月 & "月", lookat:=xlWhole)
                    月row = rngFind.Row
                    地区 = .Execute(WS.Name)(0).submatches(2)
                    Set rngFind = Workbooks(clsFile).Sheets("Sheet1").Cells.Find(what:=地区, lookat:=xlWhole)
                    ロケcol = rngFind.Column
                    Workbooks(clsFile).Worksheets("Sheet1").Cells(月row, ロケcol) = Workbooks(MovBook).Worksheets(WS.Name).Range("W53")
                End If
            End With
        Next WS
    Else
        For Each WS In Worksheets
            Debug.Print WS.Name
            With CreateObject("VBScript.RegEXP")
                .Pattern = "(\d+)(月)(\W+)"
                If .test(WS.Name) Then
                    月 = .Execute(WS.Name)(0).submatches(0)
                    Set rngFind = Workbooks(clsFile).Sheets("Sheet1").Cells.Find(what:=月 & "月", lookat:=xlWhole)
                    月row = rngFind.Row
                    地区 = .Execute(WS.Name)(0).submatches(2)
                    Set rngFind = Workbooks(clsFile).Sheets("Sheet1").Cells.Find(what:=地区, lookat:=xlWhole)
                    ロケcol = rngFind.Column
                    Workbooks(clsFile).Worksheets("Sheet1").Cells(月row, ロケcol) = Workbooks(MovBook).Worksheets(WS.Name).Range("W88")
                End If
            End With
        Next WS
    End If
End Function

確かに、冷静に頭を冷やして考ええると、標準モジュールと簡単なコードで十分作成可能でした。
何でこれほどまでに悩んでいたのか、自分でもわかりません。

とりあえず、教えていただいたことは無駄にせず、これからの糧としていきたいと思います。
コメントいただいた皆様、ありがとうございました。
(ろでます) 2014/10/20(月) 16:36


 いや本人が分かりやすいのが一番ですよ。
 ロジックを変えずに、変更した方が良いと思われる部分をちょっとだけ書いておきます。

 ◆解説月のSelectCase分
  1)SaveAsメソッドのFileFormatプロパティは是非入れた方がいいと思います。指定しないとxlsmで
   保存したくなったときに、エラーになるので今の内明確に!
  2)ブックやシートが特定されていませんので、これは特定してあげるべきです。
  3)Rangeに一個ずつ「月」を入れていますが、実は1行で入れられます。
  4)上半期が二個ありますが、1個でいいですよね?

    Set wb = Workbooks.Add
    WB.SaveAs Path_Desk & 解析月 & エリア & "売上高.xlsx", xlWorkbookDefault '★(1
    With wb.Sheets(1)                                                        '★(2
        Select Case 解析月
            Case "第一四半期": .[A2:A4] = [{"04月";"05月";"06月"}]           '★(3
            Case "第二四半期": .[A2:A4] = [{"07月";"08月";"09月"}]
            Case "第三四半期": .[A2:A4] = [{"10月";"11月";"12月"}]
            Case "第四四半期": .[A2:A4] = [{"01月";"02月";"03月"}]
            Case "上半期":     .[A2:A7] = [{"04月";"05月";"06月";"07月";"08月";"09月"}] '★(4
            Case "下半期":     .[A2:A7] = [{"10月";"11月";"12月";"01月";"02月";"03月"}]
            Case "年度":       .[A2:A13] = [{"04月";"05月";"06月";"07月";"08月";"09月";"10月";"11月";"12月";"01月";"02月";"03月"}]
            Case "年":         .[A2:A13] = [{"01月";"02月";"03月";"04月";"05月";"06月";"07月";"08月";"09月";"10月";"11月";"12月"}]
        End Select
    End With

 []で括ったところは、Evaluateメソッドの省略です。
 Evaluateメソッドはヘルプで確認してください。
 ちなみに[]のときは変数を使えませんが、省略せずEvaluate()としたときは変数も入れることが可能です。

 {}の中は、配列数式です。
 適当なシートでA1:A5を選択して、={1;2;3;4;5}を入力し、Ctrl+Shit+Enterを押してください。
 次にA1:E1と入力して={"A","B","C","D","E"}を入力し、Ctrl+Shit+Enterを押してください。

 「;」で区切ると行方向
 「,」で区切ると列方向の配列になります。
 組み合わせることも可能で、A1:B2={1,2;3,4}として配列で入力すると
 1 2
 3 4
 となります。

 ◆Findについて
 >Set rngFind = Workbooks(clsFile).Sheets("Sheet1").Cells.Find(what:=月 & "月", lookat:=xlWhole)
 >月row = rngFind.Row
 これは見つかる前提で記述していますが、通常見つからないことを想定されたほうが
 デバッグエラーにならずに良いと思います。

 >月row = rngFind.Row
 この行の前に
 If rngFind Is Nothing Then MsgBox 月 & "が見つかりません。" : Exit Sub
 のようなものを入れておいた方がいいのではないでしょうか?

 以上気になった点でした。

(稲葉) 2014/10/20(月) 19:01


こんにちは。お疲れ様でした。

コードは見ておりません(おい!)が、仕様どおりに動いているなら
これでいつでも会社への義理は果たせるということで。

あらためてdictionaryなりクラスなり 学びたいことを質問されては
いかがですか^^
このスレッドもかなり長くなりましたし、心機一転、あたらしいスレッドを
立てられたほうがいいかな、と思います。たぶんいろんなかたのコメントを
いただけるでしょう。

※クラスはまだすこししんどいかなと感じますが。

( 佳 ) 2014/10/20(月) 19:36


>稲葉様・佳様
コメントありがとうございます。

とりあえず、最終報告というかなんというか。
上司にできたものを見せると、更にこうしてほしい、ああしてほしいと、更に無茶ばっかり言ってきて・・・。
本当に会社とは非情なものです。

とりあえず、このスレッドはこれで閉めて、またその非情な要求仕様に応えるべく、マクロを組んでいきますので、その際分からない点等ありましたら、ぜひともご助力のほどをお願い申し上げます。

本当にありがとうございました。
(ろでます) 2014/10/21(火) 12:11


 >上司にできたものを見せると、更にこうしてほしい、ああしてほしいと、更に無茶ばっかり言ってきて・・・。 

 個人的に、ですが上司の所為ではないと思います。
 そのデータをどのように使うか、仕様を明確にしてから取り組まなかったプログラマにも責任が
 あります。

 更に言えば要求が増えることを想定してマクロを組まなかったしわ寄せが来ているとも思います。

 最後の方ですが、データベースの有り方について言及しました。
 どのような要求か分かりませんが、一つの表にデータをまとめたものを準備しておけば、その
 表を集計・抜き出し・整形すればよいので、また1からブックを読み取って〜〜〜
 という工程を組み立てる必要は有りません。 

 時間があって理解したいというなら、マクロの内容よりもデータベースの有り方についてもう一度
 勉強してみてください。
(稲葉) 2014/10/21(火) 13:06

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.