Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9052 / 13646 ツリー ←次へ | 前へ→

【29514】最終行での集計について SS 05/10/6(木) 20:17 質問[未読]
【29516】Re:最終行での集計について かみちゃん 05/10/6(木) 20:29 発言[未読]
【29537】Re:最終行での集計について SS 05/10/7(金) 9:49 質問[未読]
【29597】Re:最終行での集計について SS 05/10/9(日) 1:12 質問[未読]
【29599】Re:最終行での集計について とまと 05/10/9(日) 8:22 回答[未読]
【29600】Re:最終行での集計について かみちゃん 05/10/9(日) 8:23 回答[未読]
【29630】Re:最終行での集計について SS 05/10/9(日) 21:33 お礼[未読]
【29631】Re:最終行での集計について SS 05/10/9(日) 21:50 質問[未読]
【29632】Re:最終行での集計について かみちゃん 05/10/9(日) 22:13 発言[未読]
【29634】Re:最終行での集計について SS 05/10/10(月) 0:01 質問[未読]
【29640】Re:最終行での集計について とまと 05/10/10(月) 3:42 回答[未読]
【29641】Re:最終行での集計について かみちゃん 05/10/10(月) 7:12 回答[未読]

【29514】最終行での集計について
質問  SS  - 05/10/6(木) 20:17 -

引用なし
パスワード
   お願いします。
下記のような出勤管理表を使用しています。
毎日、出勤と時間外(内容によりセル色で区別)の人数を求めるのですが

これをマクロで一日の出勤者数、セル色(黄)の数、セル色(赤)の数のカウント
をしたく思います。(セル色の変化は既にマクロ設定済み)
頻繁に行の追加や削除が行われるため、セルを指定してのデータ表示が不可能です。
開始行は3行目で固定していますが最終行は雇用の数で常にかわります。
この状況で最終行以降にカウント数表示をする方法をアドバイス頂きたく思います。
また、関数での設定は転記の際に不都合がありますのでマクロが希望です。
お手数とは思いますがどうかよろしくお願いします。


 A   B   C   D    E    F   J  H
1        
2名前 区分  所属   10/1  10/2  10/3
3山田 正社員      8(時間) 8    9
4佐藤 正社員      8        10
6鈴木 正社員      10    8    8  
7田中 パート      8    10     
8加藤 パート      9    11    10
9

        
80     合計出勤者 60名  65名   55名    
      セル色(黄) 10名  12名   8名
      セル色(赤) 12名  13名   5名
     
   

【29516】Re:最終行での集計について
発言  かみちゃん  - 05/10/6(木) 20:29 -

引用なし
パスワード
   こんにちは。かみちゃん です。

何点か確認させてください。

>これをマクロで一日の出勤者数、セル色(黄)の数、セル色(赤)の数のカウント
をしたく思います。(セル色の変化は既にマクロ設定済み)

セルの色は、「セルの書式設定」「条件付き書式」どちらで設定していますか?
できれば、どういうコードで設定しているのかを教えていただけるとありがたい
のですが・・・

>頻繁に行の追加や削除が行われるため、セルを指定してのデータ表示が不可能です。

関数の設定ではなく、マクロで集計したいとのことですが、その方法だと行の削除
を行なっても削除された行の値を減算することはできません。
集計マクロを再実行する(いわゆる再計算)ことになりますが、それでいいですか?

>開始行は3行目で固定していますが最終行は雇用の数で常にかわります。
>この状況で最終行以降にカウント数表示をする方法をアドバイス頂きたく思います。

最終行は、Range("A65536").End(xlUp)で取得できるのですが、最終行以降という
のは、あいまいです。
最終行の次の行とか、1行空白行を入れるか具体的なところを教えてください。

>80     合計出勤者 60名  65名   55名    

合計出勤者の数え方が不明です。

【29537】Re:最終行での集計について
質問  SS  - 05/10/7(金) 9:49 -

引用なし
パスワード
   かみちゃん さん 恐れ入ります。

1、セル色の設定は条件付書式になます。
 しかし時々セルの書式設定で変更します。
条件付書式は
   If Cells(i, 4).Value > Cells(1, 4).Value And _
    Cells(i, 4).Value <= Cells(1, 6).Value Then
    Cells(i, K).Interior.ColorIndex = 3
という感じです。


2、>行の削除を行なっても削除された行の値を減算することはできません。
 >集計マクロを再実行する(いわゆる再計算)ことになりますが、それでいいですか?

はい、そのつもりです。

3、最終行の次の行が理想です。

4、>>80  合計出勤者 60名  65名   55名    
  >合計出勤者の数え方が不明です。

  D列以降にはその日の勤務した時間(8であれば8時間勤務)が記載されます。
  記載があれば出勤したということになり、空白であれば休暇になります。
  そこから、毎日の合計出勤者の数を出します。
  

うまく伝えられず申し訳ありませんでした

【29597】Re:最終行での集計について
質問  SS  - 05/10/9(日) 1:12 -

引用なし
パスワード
   自分なりに組んでいますが数値が入力されているセルのcount方法が分かりません。
アドバイスをお願いします。


Sub goukei()

Dim R as integer
Dim C as integer
Dim c1 as integer


With ActiveSheet.UsedRange
R = .Row + .Rows.Count
C = Range("D2").End(xlToRight).Count

For c1 = 4 To c

Cells(R, c1) = Range(Cells(3, c1), Cells(R, c1)).Count
Next c1
End With

End Sub

【29599】Re:最終行での集計について
回答  とまと  - 05/10/9(日) 8:22 -

引用なし
パスワード
   SS さん、かみちゃんさん おはようございます。
面白そうなので考えてみました。
色つきせるのカウントはCsum関数のなかで処理しています。


Sub test()

Dim rngA As Range
Dim rowA As Long
Dim colA As Long
Dim i As Long

rowA = Range("A65536").End(xlUp).Row
colA = Range("IV2").End(xlToLeft).Column

For i = 4 To colA
  Set rngA = Cells(3, i).Resize(rowA - 2)
  Cells(rowA + 1, i).Value = Application.Count(rngA)
  Cells(rowA + 2, i).Value = cSum(rngA, 6) '黄
  Cells(rowA + 3, i).Value = cSum(rngA, 3) '赤
Next i

End Sub


Function cSum(rngA As Range, c As Long) As Long
  Dim R As Range
  For Each R In rngA
    If R.Interior.ColorIndex = c Then
      cSum = cSum + 1
    End If
  Next
End Function

【29600】Re:最終行での集計について
回答  かみちゃん E-MAIL  - 05/10/9(日) 8:23 -

引用なし
パスワード
   こんにちは。かみちゃん です。

お返事遅くなりました。

>1、セル色の設定は条件付書式になます。
> しかし時々セルの書式設定で変更します。
>条件付書式は
>   If Cells(i, 4).Value > Cells(1, 4).Value And _
>    Cells(i, 4).Value <= Cells(1, 6).Value Then
>    Cells(i, K).Interior.ColorIndex = 3

このコードだと、「条件付き書式」ではなく「セルの書式設定」による書式が設定されていると思います。
以下、条件分岐による「セルの書式設定」がされているという前提で書きます。


>4、>>80  合計出勤者 60名  65名   55名    
>  >合計出勤者の数え方が不明です。
>
>  D列以降にはその日の勤務した時間(8であれば8時間勤務)が記載されます。
>  記載があれば出勤したということになり、空白であれば休暇になります。
>  そこから、毎日の合計出勤者の数を出します。

たとえば、0と記載されていれば、どうしますか?
そういうことも考慮すると、一般関数のCOUNTIF関数でできると思います。

以上を踏まえて、処理するならば、以下のようなコードでできると思います。

Sub Macro1()
 Dim LastRow As Long, RowNo As Long
 Dim LastColumn As Integer, ColumnNo As Integer
 Dim lngSum03 As Long, lngSum06 As Long
 Dim c As Range
 
 LastRow = Range("A65536").End(xlUp).Row
 LastColumn = Range("IV2").End(xlToLeft).Column
 Range(Cells(LastRow + 1, 4), Cells(LastRow + 1, LastColumn)).Formula _
  = "=COUNTIF(D3:D" & LastRow & ","">0"")"
 For ColumnNo = 4 To LastColumn
  lngSum03 = 0
  lngSum06 = 0
  For RowNo = 3 To LastRow
   With Cells(RowNo, ColumnNo)
    Select Case .Interior.ColorIndex
     Case 3 '赤
      lngSum03 = lngSum03 + .Value
     Case 6 '黄
      lngSum06 = lngSum06 + .Value
    End Select
   End With
  Next
  Cells(LastRow + 2, ColumnNo).Value = lngSum03
  Cells(LastRow + 3, ColumnNo).Value = lngSum06
 Next
End Sub

【29630】Re:最終行での集計について
お礼  SS  - 05/10/9(日) 21:33 -

引用なし
パスワード
   とまと さん、かみちゃん さん ありがとうございます。

お蔭でマクロが出来ました。
親切な対応感謝します。

【29631】Re:最終行での集計について
質問  SS  - 05/10/9(日) 21:50 -

引用なし
パスワード
   かみちゃん さん 最後に一つだけお願いします。

算出した数字の横に「件」を添えるにはどうすればよいでしょうか


Sub Macro1()
 Dim LastRow As Long, RowNo As Long
 Dim LastColumn As Integer, ColumnNo As Integer
 Dim lngSum03 As Long, lngSum06 As Long
 Dim c As Range
 
 LastRow = Range("A65536").End(xlUp).Row
 LastColumn = Range("IV2").End(xlToLeft).Column
 Range(Cells(LastRow + 1, 4), Cells(LastRow + 1, LastColumn)).Formula _
  = "=COUNTIF(D3:D" & LastRow & ","">0"")"
 For ColumnNo = 4 To LastColumn
  lngSum03 = 0
  lngSum06 = 0
  For RowNo = 3 To LastRow
   With Cells(RowNo, ColumnNo)
    Select Case .Interior.ColorIndex
     Case 3 '赤
      lngSum03 = lngSum03 + .count
     Case 6 '黄
      lngSum06 = lngSum06 + .count
    End Select
   End With
  Next
  Cells(LastRow + 2, ColumnNo).Value = lngSum03 & "件"
  Cells(LastRow + 3, ColumnNo).Value = lngSum06 & "件"
 Next
End Sub

【29632】Re:最終行での集計について
発言  かみちゃん  - 05/10/9(日) 22:13 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>算出した数字の横に「件」を添えるにはどうすればよいでしょうか

ご提示のコードでできてませんか?
  Cells(LastRow + 2, ColumnNo).Value = lngSum03 & "件"
  Cells(LastRow + 3, ColumnNo).Value = lngSum06 & "件"

ただ、最初の要件は、○○名だったと思うのですが?

【29634】Re:最終行での集計について
質問  SS  - 05/10/10(月) 0:01 -

引用なし
パスワード
   かみちゃん さん ありがとうございます。

>>算出した数字の横に「件」を添えるにはどうすればよいでしょうか

>ご提示のコードでできてませんか?
>  Cells(LastRow + 2, ColumnNo).Value = lngSum03 & "件"
>  Cells(LastRow + 3, ColumnNo).Value = lngSum06 & "件"

はい、上記の部分は出来ていますが、
下記の部分の設定が分からないもので・・ 
申し訳ありません。
Range(Cells(LastRow + 1, 4), Cells(LastRow + 1, LastColumn)).Formula _
  = "=COUNTIF(D3:D" & LastRow & ","">0"")"

【29640】Re:最終行での集計について
回答  とまと  - 05/10/10(月) 3:42 -

引用なし
パスワード
   おじゃまします。(^^
かみちゃんさんのは下記のようでできそうです。

"=COUNTIF(D3:D" & LastRow & ","">0"") & ""件"""


一応自分のも修正。
Sub test()

Dim rngA As Range
Dim rowA As Long
Dim colA As Long
Dim i As Long

rowA = Range("A65536").End(xlUp).Row
colA = Range("IV2").End(xlToLeft).Column

For i = 4 To colA
  Set rngA = Cells(3, i).Resize(rowA - 2)
  Cells(rowA + 1, i).Value = Application.CountIf(rngA, ">0") & "件"
  Cells(rowA + 2, i).Value = cSum(rngA, 3) & "件" '赤
  Cells(rowA + 3, i).Value = cSum(rngA, 6) & "件" '黄
Next i

End Sub


Function cSum(rngA As Range, c As Long) As Long
  Dim R As Range
  For Each R In rngA
    If R.Interior.ColorIndex = c Then
      cSum = cSum + 1
    End If
  Next
End Function

【29641】Re:最終行での集計について
回答  かみちゃん  - 05/10/10(月) 7:12 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>下記の部分の設定が分からないもので・・ 
>申し訳ありません。
>Range(Cells(LastRow + 1, 4), Cells(LastRow + 1, LastColumn)).Formula _
>  = "=COUNTIF(D3:D" & LastRow & ","">0"")"

すでに、とまとさんからコメントがついていますが、以下でのとおりでしょうか?
Range(Cells(LastRow + 1, 4), Cells(LastRow + 1, LastColumn)).Formula _
  = "=COUNTIF(D3:D" & LastRow & ","">0"") & ""件"""

VBAコードの前に一般操作関数でどうするのかを考えてみてください。
たとえば、D3〜D100までの範囲で0より大きい値のセルを数えるには、
=COUNTIF(D3:D100,">0")
となり、末尾に何か文字列をつけるならば
=COUNTIF(D3:D100,">0") & "件"
となり、それをVBAのコードで書けば上記のとおりとなります。

ただ、「合計出勤者」に「○○件」とは?どういうことなんでしょうか?

最後に、とまとさん、夜遅くにフォローありがとうございました。

9052 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free