[[20190802124756]] 『推定値の集計』(momo) ページの最後に飛ぶ

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

 

『推定値の集計』(momo)

スケジュールから一定の期間の推定時間を集計する方法を簡便化したいです。
いい方法がありましたら教えて下さい。

文字や記号があったら推定時間をかけて算出してます。
推定時間は人毎と担当区分ごとで行っております。
担当区分はSheet1に入力しております。

見出し:3行目、空白有り
A列:日付
B3〜:氏名
推定時間:Sheet1 D21に入力

(例)

期間:7/1〜7/5
区分:区分A(山本、田中)
   区分B(鈴木)
   区分C(松下)
推定時間:7時間

見ずらいけど例ではE列は空白です。

  A    B   C    D   E   F  
1
2
3 日付  山本  田中  鈴木     松下
4 7/1   本   事   ○   
5 7/4       事   本      ○
6 7/5   ○   ○          本
7 8/3   ○       事      事

(結果:人毎)

山本 14
田中 21
鈴木 14
松下 14

(結果:区分)

区分A 35
区分B 14
区分C 14

< 使用 Excel:Excel2019、使用 OS:Windows10 >


 こんばんは ^^
下記の様な感じの表形式で、基本情報のあるシート、出力結果の
表示先等いま少し詳しくご説明いただくと、多数、アドバイス、
確認、回答があるかもしれません。 ← 多分 ^^;

 Sheet1 予測図

      A      B        C        D  
   1                              
   2  期間    7月1日   7月5日     
   3  区分   氏名     氏名        
   4  A      山本     田中        
   5  B      鈴木                 
   6  C      松下                 
   7                              
   8                              
   9                              
  10                              
  11                              
  12                              
  13                              
  14                              
  15                              
  16                              
  17                              
  18                              
  19                              
  20                              
  21                            7 
(隠居じーさん) 2019/08/02(金) 19:47

なんとなく集計のルールはわかりましたが・・

「本」、「事」、「○」は常に等しく7時間でいいのでしょうか?
でしたら、
・開始日、終了日をそれぞれ別なセルに入力
・MATCH関数で、開始日に該当する行、終了日に該当する行を取得
・OFFSET関数で、各人の対象セル範囲を取得
・その範囲に対してCOUNTA関数で、空白以外のセル数を数えて 7を掛ければ

人毎 の集計はできますね。

区分毎 が 人の組み合わせであれば、人毎の集計から、再集計することで可能でしょう。

(渡辺ひかる) 2019/08/03(土) 13:19


少しだけ使用が変更になりました。
シートは「予定表」と「結果」があります。
「結果」に条件を入力するようになっております。

シート「結果」の日付と推定時間を入力してシート「予定表」に予定表を貼りつけたら自動で集計
結果が出るようになったらいいなと思います。
予定表の行と列は都度都度変更されるので自動でする方法等が
分かりません。

K4〜は=SUMIF(F:F,J4,H:H)を入力しております。

シート「結果」

      A       B         C        D      E      F       G      H     I     J      K
   1                              
   2  条件                                 集計
   3  日付   2019/7/1  以降            コード   区分    氏名  時間       区分  時間
   4      2019/7/5  以前                1      A        山本  14       A       35
   5                              1      A    田中  21       B       14
   6  推定値    7      時間          2      B    鈴木  14       C       14     
   7                        3      C    松下  14                        
                              

 シート「予定表」

       A      B        C        D       E        F
   1                              
   2    
   3  日付   山本     田中   鈴木            松下        
   4  7/1     本    事     ○ 
   5  7/4         事     本         ○             
   6  7/5    ○    ○               本
  7  8/3     ○          事         事

(momo) 2019/08/05(月) 13:00


>予定表の行と列は都度都度変更されるので自動でする方法等が分かりません。

「結果」シートのE列、F列のデータは、「予定表」にありませんが、これは手入力ですか?

また 「予定表」のE列が空欄なのは意味がありますか?

「予定表」のA列は、とびとびであっても昇順と考えていいですか?

(渡辺ひかる) 2019/08/05(月) 13:15


シート「結果」のE列にコードを手入力したら自動で区分が返るようにしております。
シート「予定表」のE列は全てデータがあるのではなく空白の場合があるという意味です。
A列はごくたまに昇順でない場合があります。

(momo) 2019/08/05(月) 13:44


「予定表」の3行目の氏名を、「結果」のG列に 行列を入れ替えて貼り付けしてください
貼り付け後の空白セルは削除して、上詰めしてください
(この後コードを入力して区分を表示させるのですよね?)

そのうえで、
「結果」のH4セルに

=COUNTIFS(予定表!$A$5:$A$8,">="&結果!$B$3,予定表!$A$5:$A$8,"<="&結果!$B$4,OFFSET(予定表!$A$5:$A$8,,MATCH(G4,予定表!$B$4:$F$4,0)),"<>"& "")*$B$6

を入力して、必要行コピーすれば、期待する結果になると思います。

(渡辺ひかる) 2019/08/05(月) 16:47


 こんばんは ^^
お名前と、区分の対応表の所在が、あいまいなので、固定的になりましたけど、
コード中の配列を追加すれば、なんとかなるかもです。かなり無駄が有るかも
しれません、もっとスマートな方法があるとはおもいますが、作ってみました。
エラー処理。。。← ありません。お役に立たなければゴミ箱にでも m(_ _)m

 Option Explicit
Sub OneInstance01()
    Dim Rsm           As Long
    Dim Rsd           As Variant
    Dim Tmp           As Variant
    Dim i             As Long
    Dim j             As Long
    Dim k             As Long
    Dim N             As Long
    Dim Base          As Variant
    Dim DivCd         As Variant
    Dim DivNm         As Variant
    Dim Men           As Variant
    Dim MenD          As Variant
    Dim Sd            As Date
    Dim Ed            As Date
    Dim Dm            As Object
    Dim Dd            As Object
    Dim WsK           As Worksheet
    Set Dm = CreateObject("Scripting.Dictionary")
    Set Dd = CreateObject("Scripting.Dictionary")
    Set WsK = Worksheets("結果")
    With Worksheets("予定表")
        Base = Intersect(.UsedRange, .Range(.Rows(3), .Rows(.Cells(.Rows.Count, 1).End(xlUp).Row)))
    End With
    DivCd = Array(1, 2, 3)
    DivNm = Array("A", "B", "C")
    Men = Array("山本", "田中", "鈴木", "松下")
    MenD = Array(1, 1, 2, 3)
    For i = 0 To UBound(DivCd)
        If Not Dd.exists(DivCd(i)) Then
            Dd.Add DivCd(i), Array(0, DivNm(i))
        End If
    Next
    For j = 0 To UBound(Men)
        If Not Dm.exists(Men(j)) Then
            Dm.Add Men(j), Array(0, DivNm(MenD(j) - 1), DivCd(MenD(j) - 1))
        End If
    Next
    Sd = WsK.Range("B3").Value
    Ed = WsK.Range("B4").Value
    For i = LBound(Base, 1) To UBound(Base, 1)
        If Base(i, 1) >= Sd And Base(i, 1) <= Ed Then
            For j = 2 To UBound(Base, 2)
                For k = 0 To Dm.Count - 1
                    If Base(1, j) = Dm.keys()(k) Then
                        If Base(i, j) <> "" Then
                            Rsm = Dm(Base(1, j))(0)
                            Rsd = Dm(Base(1, j))(1)
                            Tmp = Dm(Base(1, j))(2)
                            Rsm = Rsm + WsK.Range("B6").Value
                            Dm(Base(1, j)) = Array(Rsm, Rsd, Tmp)
                            Rsm = 0: Rsd = "": Tmp = Empty
                            For N = 0 To Dd.Count - 1
                                If Dm.items()(k)(2) = DivCd(Dd.keys()(N) - 1) Then
                                    Rsm = Dd(Dm.items()(k)(2))(0)
                                    Tmp = Dd(Dm.items()(k)(2))(1)
                                    Rsm = Rsm + WsK.Range("B6").Value
                                    Dd(Dm.items()(k)(2)) = Array(Rsm, Tmp)
                                    Rsm = 0: Tmp = Empty
                                End If
                            Next
                        End If
                    End If
                Next
            Next
        End If
    Next
    WsK.Copy
    With ActiveWorkbook.ActiveSheet
        Intersect(.UsedRange, .Range("E:J")).Clear
        .Range("E2") = "集計"
        .Range("E3").Resize(, 6) = Array("コード", "区分", "氏名", "時間", "区分", "時間")
        N = 4
        For i = 0 To Dm.Count - 1
            .Cells(N, 5) = Dm.items()(i)(2)
            .Cells(N, 6) = Dm.items()(i)(1)
            .Cells(N, 7) = Dm.keys()(i)
            .Cells(N, 8) = Dm.items()(i)(0)
            N = N + 1
        Next
        N = 4
        For i = 0 To Dd.Count - 1
            .Cells(N, 9) = Dd.items()(i)(1)
            .Cells(N, 10) = Dd.items()(i)(0)
            N = N + 1
        Next
    End With
    Erase Base, DivCd, DivNm, Men, MenD
    Set Dm = Nothing
    Set Dd = Nothing
    Set WsK = Nothing
End Sub
(隠居じーさん) 2019/08/05(月) 23:17

コメント返信:

[ 一覧(最新更新順) ]


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