[[20140918145852]] 『●完成した一つのモジュールを三つに分ける』(syk) ページの最後に飛ぶ

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

 

『●完成した一つのモジュールを三つに分ける』(syk)

以前も質問させていただき、なんとか完成しましたが、
それを更に三分割しなければいけません。
以前私は、一つのモジュールにマクロをざっと書き上げていましたが、
他のプログラマが見やすいように、

読み込み(取り込み)、集計、出力
に分けなければいけません。
もう完成しているため、少しでも移動したり変更すると、うまくいかなくなってしまいます。
そもそも、できあがっているものをどう分けたらいいのか、よくわからない状態です。
このマクロは読みこんでいる、集計している、出力している、というのはわかるんですが、そのマクロを出力モジュールのほうに移したりすると、オブジェクト等も一緒に持ってこなければいけないので、結局一緒になってしまいます。

他の方には、引数をつかえと言われましたが、引数は理解したんですが、それをどのマクロにどのように引用すればいいのかわからず、うまく使えません。
無知で本当に申し訳ないですが、教えていただけたら幸いです。

少し長くなりますが、できているマクロはこちらです。

Private Sub btn_集計_Click()

    ' 集計
    Call 集計

End Sub

Public Sub 集計()

    Dim S1 As Worksheet, S2 As Worksheet
    Dim cellオーダー番号 As Range
    Dim cellオーダー名 As Range
    Dim strオーダー番号 As String
    Dim strオーダー名 As String
    Dim cell条件マンNo As Range
    Dim str条件マンNo As String
    Dim cellマンNo As Range
    Dim strマンNo As String
    Dim cell契約時間 As Range
    Dim dbl契約時間 As Double
    Dim cell社員時間 As Range
    Dim dbl社員時間 As Double
    Dim strWork As String
    Dim idx As Long
    Dim out As Range
    Dim item As Variant
    Dim key As Variant

    Dim dic契約時間 As Object
    Set dic契約時間 = CreateObject("Scripting.Dictionary")
    Dim dic社員時間 As Object
    Set dic社員時間 = CreateObject("Scripting.Dictionary")
    Dim dic協力会社 As Object
    Set dic協力会社 = CreateObject("Scripting.Dictionary")
    Dim dic社員 As Object
    Set dic社員 = CreateObject("Scripting.Dictionary")

    Set S1 = Worksheets("集計結果")
    Set S2 = Worksheets("データ")

    Dim row As Long
    Dim rowCnt As Long

    rowCnt = S2.Range("A2").End(xlDown).row

    str条件マンNo = S2.Range("C1").Value

    For row = 2 To rowCnt

        Set cellオーダー番号 = S2.Range("A" & row)
        Set cellオーダー名 = S2.Range("B" & row)
        strオーダー番号 = cellオーダー番号.Value
        strオーダー名 = cellオーダー名.Value
        Set out = S1.Range("A" & row)
        Set cellマンNo = S2.Range("C" & row)
        strマンNo = cellマンNo.Value
        Set cell契約時間 = S2.Range("D" & row)
        dbl契約時間 = CDbl(cell契約時間.Value)
        Set cell社員時間 = S2.Range("D" & row)
        dbl社員時間 = CDbl(cell社員時間.Value)

        If strマンNo = str条件マンNo Then

            If Not dic協力会社.Exists(strオーダー番号) Then

                With dic協力会社
                    .Add item:=strオーダー番号 & " " & strオーダー名, key:=strオーダー番号

                End With

                With dic契約時間
                    .Add item:=dbl契約時間, key:=strオーダー番号

                End With

            Else

                With dic契約時間

                dic契約時間(strオーダー番号) = dic契約時間(strオーダー番号) + dbl契約時間

                End With

            End If

        Else

            If Not dic社員.Exists(strオーダー番号) Then

                With dic社員
                    .Add item:=strオーダー番号 & " " & strオーダー名, key:=strオーダー番号

                End With

                 With dic社員時間
                    .Add item:=dbl社員時間, key:=strオーダー番号

                End With

            Else

                With dic社員時間

                dic社員時間(strオーダー番号) = dic社員時間(strオーダー番号) + dbl社員時間

                End With

            End If

        End If

    Next row

        key = dic社員.keys
        item = dic社員.items
        For idx = 0 To UBound(key)
            ' Cells(idx + 3, 1).Value = key(idx)
            Cells(idx + 3, 1).Value = item(idx)
        Next
        Set myDic = Nothing

        key = dic協力会社.keys
        item = dic協力会社.items
        For idx = 0 To UBound(key)
            ' Cells(idx + 3, 1).Value = key(idx)
            Cells(idx + 15, 1).Value = item(idx)
        Next
        Set myDic = Nothing

        Set out = S1.Range("A" & (idx + 9))
        out.Value = "【協力会社】"
        Set out = S1.Range("A" & (idx + -3))
        out.Value = "【社員】"

        key = dic契約時間.keys
        item = dic契約時間.items

        For idx = 0 To UBound(key)
            ' Cells(idx + 3, 1).Value = key(idx)
            Cells(idx + 15, 2).Value = item(idx)
        Next

        key = dic社員時間.keys
        item = dic社員時間.items

        For idx = 0 To UBound(key)
            ' Cells(idx + 3, 1).Value = key(idx)
            Cells(idx + 3, 2).Value = item(idx)
        Next

        S1.Range("B3:B19").HorizontalAlignment = xlRight

End Sub

よろしくおねがいします。

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


 まず Option Explicit を使ったほうが良いと思います。
 不要な変数が残っていて、見づらくなっています。

 それから With を使用するのは悪くありませんが、1行処理のためでしたら直接指定の
 方が見やすいです。 With を指定して、使っていないところもありますし。

 変数へ一旦代入したほうが、意味がわかりやすいというのはあると思いますが、
 セル、データの代入が過多にあり、冗長に感じます。

 その他にもいろいろ気になる点は多いですけれど、とりあえずコードの分割例です。
 (読込みと集計は同時処理なので、2分割です。)

 多少推測もありますし、動作検証はしていませんので、思い通りにならない場合は
 破棄ください。

 '//------------------------------------------------
 Option Explicit

 '//------------------------------------------------
 '//------------------------------------------------
 Public dic契約時間 As Object
 Public dic社員時間 As Object
 Public dic協力会社 As Object
 Public dic社員 As Object

 '//------------------------------------------------
 Private Sub btn_集計_Click()
 '//------------------------------------------------
    集計 Worksheets("データ")
    出力 Worksheets("集計結果")
 End Sub

 '//------------------------------------------------
 Public Sub 集計(データシート As Worksheet)
 '//------------------------------------------------
    Set dic契約時間 = CreateObject("Scripting.Dictionary")
    Set dic社員時間 = CreateObject("Scripting.Dictionary")
    Set dic協力会社 = CreateObject("Scripting.Dictionary")
    Set dic社員 = CreateObject("Scripting.Dictionary")

    Dim rowCnt As Long
    rowCnt = データシート.Range("A2").End(xlDown).row

    Dim 条件マンNo As String
    条件マンNo = データシート.Range("C1").Value

    Dim オーダー番号 As String
    Dim オーダー名 As String
    Dim マンNo As String
    Dim 時間 As Double

    Dim row As Long
    For row = 2 To rowCnt
        オーダー番号 = データシート.Cells(row, "A")
        オーダー名 = データシート.Cells(row, "B")
        マンNo = データシート.Cells(row, "C")
        時間 = CDbl(データシート.Cells(row, "D"))

        If マンNo = 条件マンNo Then
            If Not dic協力会社.Exists(オーダー番号) Then
                dic協力会社.Add item:=オーダー番号 & " " & オーダー名, key:=オーダー番号
                dic契約時間.Add item:=時間, key:=オーダー番号
            Else
                dic契約時間(オーダー番号) = dic契約時間(オーダー番号) + 時間
            End If
        Else
            If Not dic社員.Exists(オーダー番号) Then
                dic社員.Add item:=オーダー番号 & " " & オーダー名, key:=オーダー番号
                dic社員時間.Add item:=時間, key:=オーダー番号
            Else
                dic社員時間(オーダー番号) = dic社員時間(オーダー番号) + 時間
            End If
        End If
    Next
 End Sub

 '//------------------------------------------------
 Public Sub 出力(結果シート As Worksheet)
 '//------------------------------------------------
    結果シート.Range("A2").Value = "【社員】"
    結果シート.Range("A14").Value = "【協力会社】"

    Dim 行 As Long
    Dim key
    行 = 3
    For Each key In dic社員.keys
        結果シート.Cells(行, "A").Value = dic社員(key)
        結果シート.Cells(行, "B").Value = dic契約時間(key)
        行 = 行 + 1
    Next

    行 = 15  '//  決め打ちは、社員データが 12 以上あったらまずいと思うけれど・・・
    For Each key In dic協力会社.keys
        結果シート.Cells(行, "A").Value = dic協力会社(key)
        結果シート.Cells(行, "B").Value = dic契約時間(key)
        行 = 行 + 1
    Next

    結果シート.Range("B3:B19").HorizontalAlignment = xlRight
 End Sub
(Mook) 2014/09/18(木) 16:18

 mookさん
ありがとうございます!
素晴らしいです。

これからやってみます。
結果はどうであれ、これで考えがまた広がりました。うれしいです。
このマクロを参考にしてみます!
またわからないところはお聞きしてしまうかもしれません。
その際はよろしくお願いします。
(syk) 2014/09/18(木) 16:23


mookさん
できました!!!
すごいです。
あとは、これを理解します。
とても勉強になりました!助かりました!
(syk) 2014/09/18(木) 16:34

mookさん
すみません、かなりの進歩だったんですが、
やはり取込もわけなければいけません、、。
mookさんだったら無理やり分けるときどうされますか?
(syk) 2014/09/18(木) 16:35

 私なら、
 今の処理を見て、分ける必要は感じないので、「分けろ」といっている人に現状を説明して
 説得します。

 それでも何がなんでも無理やり分けろ!となったら
 「集計」をコピーして、A列の処理(登録)と、B列の処理(集計?)と分離します。
 分けることにより、整合の確認をするよう、多少の処理は追加になるでしょうけれど。

 不毛な作業です・・・。
(Mook) 2014/09/18(木) 17:01

Dictionaryを使っているのだから、取込=集計 でしょう。これを分けろという方がおかしいと思いますよ?
(???) 2014/09/18(木) 17:01

mookさん、???さん、

そうですよね。
仕事として考えたらおかしい要求なんですが、
実は勉強のために作っているんです。

理解をするために三つわけて、ここではこの作業をする、というのをわかってほしい目論見だと思います。

ただ、本当に無知でこの業界に入り、勉強したいのですが、まずは自分で考えてほしいと言われ、教えてくれる人がいなかったので、ここで質問した、、という状況です。
頭の中が空っぽなので、まずは答えを見て、そこからなぜこうなるのかと考えたほうが理解できると思っての行動です。

取込に関しては、なんとかしてみます!
本当にありがとうございました。
またご迷惑おかけすると思いますが、よろしくお願いします。
(syk) 2014/09/18(木) 17:13


 そういう背景も説明したほうが良いですね。
 サンプルデータや処理目的(課題)が提示されたものであれば、そもそもそれを提示した
 方が混乱無いとは思います。

 でも、であるとすると質問の丸投げでは、実力にならないとも思いますけれど。

 最初のものと、今回提示したものの、どこがどう変わったかは確認できたのでしょうか。
(Mook) 2014/09/18(木) 17:18

mookさん

そうですね、そこは私のミスでした。
本当に申し訳ありません。

今は、確認途中にさらに私のミスに気づき、それをどうしようか、というところで詰まっています。
お恥ずかしいです。
(syk) 2014/09/18(木) 17:29


 この問題には、データというシートにあるデータ例とその結果を出力する集計結果というシートの
 結果例の提示も必要ですよ!!

 この提示がないと、プログラムの設計ってできませんから・・・・。

 仕様、入力データ例、そのデータ例からの出力データ等から、プログラムの骨格を決めます。

 コード、拝見しました。
 何度かこの掲示板では申し上げていますが、

 前処理  -----n回のループ-----後処理

 これが基本の構造です。これを大きく逸脱する場合、プログラムの分割を視野に入れます。
 プログラムの骨格がこの構造になっていると、わかりやすいものです。

 拝見したコードは、大きくは、この骨格からずれてはいません。
 特にExcelシートが入力データの場合は、私たちが目で直接、確認ができますから、提示されたようなプロシジャーでも良いと思いますし、私もこのような骨格にすることも少なくありません。

 が、これをモジュール分割する意味は 0とは言えません。

 時間集計-------シート読込管理 
     |
     |----集計管理 

 時間集計(Module1)というプログラムは、 シート読込管理(Module2) 、集計管理(Module3)という
 モジュールに分割して管理します。
 プロシジャー分割ではなく、モジュール分割です。

 新規ブックにて、"データ"と"集計結果" というシートを用意し、シート"データ”には、
 所定のデータを準備してください。

 次投稿にて コードです。

 

( ichinose) 2014/09/19(金) 16:27


 では、コードです。前述の新規ブックに

 VBEにて、標準モジュールを3つ(Module1、Module2、Module3)準備してください。

 まず、Module2です。本来は、このモジュール名を「シート読込管理」と命名するのですが、これは、今回は
 省略です。

 '===========================================================================================
 Option Explicit
 Private Lrow As Long
 Private Crow As Long
 Private Insht As Worksheet
 '===========================================================================
 Sub Insht_Open(ByVal sht As Worksheet)
 '読み込みシートの指定
    With sht
       Lrow = sht.Cells(.Rows.Count, "a").End(xlUp).row
    End With
    Crow = 2
    Set Insht = sht
 End Sub
 '===========================================================================
 Function Insht_get(Optional O_No As String, Optional O_nm As String, Optional O_マン As String,    Optional O_val As Double) As Long
  '読み込みシートからデータを取得
  ' Insht_get 0--読込正常終了 1--データの終わり
    Insht_get = 1
    If Crow <= Lrow Then
       O_No = Insht.Range("A" & Crow).Value
       O_nm = Insht.Range("B" & Crow).Value
       O_マン = Insht.Range("C" & Crow).Value
       O_val = Insht.Range("D" & Crow).Value
       Insht_get = 0
       Crow = Crow + 1
    End If
 End Function
 '===========================================================================
 Function Insht_get_cond()
  '条件データの取得
    Insht_get_cond = Insht.Range("c1").Value
 End Function
 '===========================================================================
 Sub Insht_close()
  '読込シートの指定解除
    Lrow = 0
    Crow = 0
    Set Insht = Nothing
 End Sub

 ここでInsht_Openで指定したシートがデータのあるシートだと解釈し、このシートの情報は、
 このモジュールにて一元管理することにします。
 通常、ファイルの中のデータって ファイルのオープン、ファイルのデータの取得、ファイルのクローズ
 等という手順でデータを取得しますよね?このモジュールもおおよそ、そのような手続きで成り立っています。

 このように作成しておくと、例えば、
 データの挿入(契約時間の列の前にどうしても一項目挿入しなければならない事象が発生した場合等)、
 このモジュールだけの変更で極力、他を変更しなくてもすむようにしたい時など便利です。

 Module3のコード 集計管理

 '======================================================================================
 Option Explicit
 Private svcnt As Long
 Private dic() As Dictionary
 Sub 集計_open(Optional cnt As Long = 1)
  '集計領域のオープン cnt 作成する集計領域の数
    Dim g0 As Long
    ReDim dic(1 To cnt)
    For g0 = 1 To cnt
       Set dic(g0) = CreateObject("scripting.dictionary")
    Next
    svcnt = cnt
 End Sub
 '======================================================================================
 Function 集計_get(key As String, Optional id As Long = 1) As Variant
 '指定キーの集計データの取得 idは、領域番号
    集計_get = False
    If dic(id).exist(key) Then
       集計_get = dic(id)(key)
    End If
 End Function
 '======================================================================================
 Sub 集計_set(ByVal key As String, ByVal data1 As Variant, data2 As Variant, Optional id As Long = 1)
 '指定キーの集計データの設定 idは、領域番号
    Dim x As Variant
    If dic(id).Exists(key) Then
       x = dic(id)(key)
       x(1) = x(1) + data2
       dic(id)(key) = x
    Else
       dic(id)(key) = Array(data1, data2)
    End If
 End Sub
 '======================================================================================
 Function 集計_get_items(Optional id As Long = 1) As Variant
 '集計データの取得 配列
   集計_get_items = dic(id).Items
 End Function
 '======================================================================================
 Function 集計_get_keys(Optional id As Long = 1) As Variant
 '集計キーの取得 配列
   集計_get_items = dic(id).Keys
 End Function
 '======================================================================================
 Sub 集計_close()
 '集計領域のクローズ
    Dim g0 As Long
    For g0 = 1 To svcnt
       Set dic(g0) = Nothing
    Next
 End Sub

 集計に関する処理を一括して引き受けいるモジュールです。

 実は、集計_get と集計_get_keysというプロシジャーは、今回の仕様では、使っていません。

 このようにモジュール分割を行うと、今回の仕様からは、一歩退いたところでこの集計管理という機能を
 見つめることができます。そうすると、今は、使わないけど、将来、この機能が必要になるかもしれない
 なんてことを客観視することができますよ!!その場合、ここに先に作っておくということも考えられます。

 最後にModule1に 今回の仕様を実現するコード

 '====================================================================================
 Sub 集計()
    Dim S1 As Worksheet
    Dim strオーダー番号 As String
    Dim strオーダー名 As String
    Dim str条件マンNo As String
    Dim strマンNo As String
    Dim db時間 As Double
    '
    Set S1 = Worksheets("集計結果")
    Dim id As Long
    Dim myarray As Variant
    Dim K_rw As Long
    Call Insht_Open(Worksheets("データ"))

    Call 集計_open(2)
    str条件マンNo = Insht_get_cond
 '
    Do Until Insht_get(O_No:=strオーダー番号, O_nm:=strオーダー名, O_マン:=strマンNo, O_val:=db時間)
       id = 1
       If strマンNo <> str条件マンNo Then id = 2
       Call 集計_set(strオーダー番号, strオーダー番号 & " " & strオーダー名, db時間, id)
    Loop
 '
    With S1    '出力
       .Range("a2").Value = "【社員】"
       myarray = 集計_get_items(1)
       If UBound(myarray) <> -1 Then
          .Range("a3:b" & (UBound(myarray) + 3)).Value = Application.Transpose(Application.Transpose(myarray))
       End If
       K_rw = 3 + IIf(UBound(myarray) = -1, 1, UBound(myarray)) + 3
       .Range("a" & K_rw).Value = "【協力会社】"
       myarray = 集計_get_items(2)
       If UBound(myarray) <> -1 Then
          .Range("a" & (K_rw + 1) & ":b" & (UBound(myarray) + K_rw + 1)).Value = Application.Transpose(Application.Transpose(myarray))
       End If
       .Range("B3:B" & (UBound(myarray) + K_rw)).HorizontalAlignment = xlRight
    End With
    Set S1 = Nothing
    Call Insht_close
    Call 集計_close
 End Sub

 データというシートは、

         A            B          C         D
 1  オーダーNO   オーダー名      1       契約時間
 2     あ          ああああ        1       2:30:00
 3     い          いいいい        2       1:50:00
 4     う          うううう        2       3:00:00
 5     え          ええええ        1       4:00:00
 6     お          おおおおおお    1       2:00:00
 7     う          うううう        2       1:50:00
 8     い          いいいい        2       0:30:00
 9     あ          ああああ        1       1:15:00

 このようなデータでテストしましたが

 【社員】	
 あ ああああ	   3:45:00
 え ええええ	   4:00:00
 お おおおおおお   2:00:00

 【協力会社】	
 い いいいい       2:20:00
 う うううう       4:50:00

 このような結果が得られました。 時間は、書式設定が必要です。

( ichinose) 2014/09/19(金) 17:59


ichinoseさん

気づくのが遅くなり、すみません!
たくさん書いていただき、とてもうれしいです。
このような方法もあるのですね・・・。

ichinoseさんのやり方を見る前にできてしまったのが残念ですが、
これもどのようになってるのが見て、勉強させていただきます!
本当にありがとうございます!
(syk) 2014/09/25(木) 09:50


今回、たくさんの方に助言をいただき、
無事完成しました。
一部修正は残ってますが・・・。

mookさんの書いてくれたものを参考に(パクりです)、作りました。

データの例などはちょっと提示できません。どう例えたらよいのかもわからず、すみません・・・。

こちらが、できたコードになります。

コメントは、自分が理解してるかどうか確認の為書いています。
理解できてない部分があれば、丸見えの恥ずかしい状態ですが、そのまま載せます。

Option Explicit

 Sub btn_集計_Click()

    Dim obj取込Array(42, 4) As Variant 'データが42項目あったので、直接入力した
    Dim objDic達Array(3) As Object '4項目なので配列3で十分だが、★1(別モジュール)の理由で配列4にした

   '取込を呼び出す
    取込 Worksheets("オーダー実績出力"), obj取込Array, objDic達Array

    '集計を呼び出す
    集計 Worksheets("集計結果"), obj取込Array, objDic達Array()

    '出力を呼び出す
    出力 Worksheets("集計結果"), objDic達Array()

End Sub

Sub 取込(ByRef オーダー実績出力 As Worksheet, obj取込Array As Variant, objDic達Array() As Object) '取込()を渡す

    Dim row As Long

    Const 参照No開始行 As Integer = 2    '2列目から開始する作業の名前「参照No開始行」

    For row = 参照No開始行 To オーダー実績出力.Range("B2").End(xlDown).row    'オーダー実績出力のB2参照No開始行(2)の値が存在する最後の行まで続ける。

        With オーダー実績出力

              'rowは参照No開始行(2行目)からなので、その分マイナスして1行目からの値を初期値にする
              '各データを、配列obj取込Arrayの中に入れる
            obj取込Array(row - 参照No開始行, 0) = .Range("B" & row) '(オーダーNo)
            obj取込Array(row - 参照No開始行, 1) = .Range("C" & row)   '(オーダー名)
            obj取込Array(row - 参照No開始行, 2) = .Range("E" & row)   '(マンNo)
        End With

                    '小数点表示するようにCDbl
          obj取込Array(row - 参照No開始行, 3) = CDbl(オーダー実績出力.Range("H" & row))    '契約時間
          obj取込Array(row - 参照No開始行, 4) = CDbl(オーダー実績出力.Range("H" & row))    '社員時間

   Next

End Sub

Sub 集計(集計結果 As Worksheet, obj取込Array As Variant, objDic達Array() As Object) '集計を渡す

    Dim str条件マンNo As String
    Dim strWork As String
    Dim row2 As Long

    Const 契約時間 As Integer = 0
    Const 社員時間 As Integer = 1
    Const 協力会社 As Integer = 2
    Const 社員 As Integer = 3

    Dim dic契約時間 As Object
    Dim dic社員時間 As Object
    Dim dic協力会社 As Object
    Dim dic社員 As Object

        '既存エラーを出さない為の宣言
    Set dic契約時間 = CreateObject("Scripting.Dictionary")
    Set dic社員時間 = CreateObject("Scripting.Dictionary")
    Set dic協力会社 = CreateObject("Scripting.Dictionary")
    Set dic社員 = CreateObject("Scripting.Dictionary")

        'この宣言はpublicでしている
    Set objDic達Array(3) = CreateObject("Scripting.Dictionary")

    Set objDic達Array(0) = dic契約時間
    Set objDic達Array(1) = dic社員時間
    Set objDic達Array(2) = dic協力会社
    Set objDic達Array(3) = dic社員

    str条件マンNo = 集計結果.Range("C1").Value 'str条件マンNoに、集計結果のC1の値を入れる

    For row2 = 0 To UBound(obj取込Array, 1)   '配列obj取込Arrayの一行目から、最後の値まで見る

        If obj取込Array(row2, 2) = str条件マンNo Then  'もし条件マンNoとマンNoが同じであるとき

            If Not objDic達Array(協力会社).Exists(obj取込Array(row2, 0)) Then     '協力会社欄に格納し、さらにもしセルにオーダー番号がないとき

                objDic達Array(協力会社).Add item:=obj取込Array(row2, 0) & " " & obj取込Array(row2, 1), key:=obj取込Array(row2, 0)     '協力会社の項目に、オーダー番号とオーダー名の間に空白を空け、追加して格納する
                objDic達Array(契約時間).Add item:=obj取込Array(row2, 3), key:=obj取込Array(row2, 0)                               '契約時間の項目に追加して格納する

            Else                                                'オーダー番号があるとき

                objDic達Array(契約時間)(obj取込Array(row2, 0)) = objDic達Array(契約時間)(obj取込Array(row2, 0)) + obj取込Array(row2, 3)             '既存する契約時間項目に選択中の契約時間を合計して、項目に返し格納する

            End If

        Else                                'マンNoが同じでないとき

            If Not objDic達Array(社員).Exists(obj取込Array(row2, 0)) Then          '社員欄に格納し、さらにセルにオーダー番号がないとき

                objDic達Array(社員).Add item:=obj取込Array(row2, 0) & " " & obj取込Array(row2, 1), key:=obj取込Array(row2, 0)          '社員の項目に、オーダー番号とオーダー名の間に空白を空け、追加して格納する
                objDic達Array(社員時間).Add item:=obj取込Array(row2, 4), key:=obj取込Array(row2, 0)                               '社員時間の項目に追加して格納する

            Else                                                'オーダー番号があるとき

                objDic達Array(社員時間)(obj取込Array(row2, 0)) = objDic達Array(社員時間)(obj取込Array(row2, 0)) + obj取込Array(row2, 4)            '既存する社員時間項目に選択中の社員時間を合計して、項目に返し格納する

            End If

        End If

    Next row2

End Sub

Sub 出力(集計結果 As Worksheet, objDic達Array() As Object) '出力()を渡す

    Const 契約時間 As Integer = 0
    Const 社員時間 As Integer = 1
    Const 協力会社 As Integer = 2
    Const 社員 As Integer = 3

    Dim idx As Long
    Dim key As Variant
    Dim item As Variant

    key = objDic達Array(社員).keys
    item = objDic達Array(社員).items
    For idx = 0 To UBound(key)                      '社員の最大数値を返す処理を最後まで繰り返す
        Cells(idx + 3, 1).Value = item(idx)         '1行目の3列目まで繰り返す
    Next

    key = objDic達Array(協力会社).keys
    item = objDic達Array(協力会社).items
    For idx = 0 To UBound(key)                      '協力会社の最大数値を返す処理を最後まで繰り返す
        Cells(idx + 15, 1).Value = item(idx)        '1行目の15列目まで繰り返す
    Next

    With 集計結果
        .Range("A" & (idx + 9)) = "【協力会社】"            '集計結果sheetのA列の最大数値セルから9行目に【協力会社】を入力
        .Range("A" & (idx + -3)) = "【社員】"               '集計結果sheetのA列の最大数値セルから-3行目に【社員】を入力
        .Range("B3:B19").HorizontalAlignment = xlRight      '集計結果sheetの範囲(B3:B19)の値を右寄せにする
    End With

    key = objDic達Array(社員時間).keys
    item = objDic達Array(社員時間).items
    For idx = 0 To UBound(key)                      '社員時間の最大数値を返す処理を最後まで繰り返す
        Cells(idx + 3, 2).Value = item(idx)         '3行目まで繰り返す
    Next

    key = objDic達Array(契約時間).keys
    item = objDic達Array(契約時間).items
    For idx = 0 To UBound(key)                      '契約時間の最大数値を返す処理を最後まで繰り返す
        Cells(idx + 15, 2).Value = item(idx)        '15行目まで繰り返す
    Next

End Sub

みなさんのおかげでここまで作ることができました。
本当に無知で「とりあえずやってみなさい」で始めたんですが、
何をしたらいいのか全くわからず、この場に丸投げするという恥ずかしいことをしました。
でも、mookさんやichinoseさん、たくさんの方々は、丸返ししてくれました。
助かりました。ありがとうございます。

(syk) 2014/09/25(木) 15:41


 まだみていらっしゃるなら、ですが
 > 他のプログラマが見やすいように、
に関することとして
「マジックナンバー」
というキーワードで色々調べてみると良いかもしれません。
 
おそらく社内で指導してくれる人も居るでしょうから、単なる老婆心ですけれども。
(ご近所PG) 2014/09/26(金) 09:34

ご近所PBさん

指摘されました・・・
二次元だとできないと勘違いしてたのであきらめていたんですが、できたので直しました。
他も、ヘッダーをつけたり、必要ない引数があったり、コメントが実況型になっているところを
まとめたりしました。

ありがとうございます!
(syk) 2014/09/26(金) 11:33


コメント返信:

[ 一覧(最新更新順) ]


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