画像みたいな感じで、5連勤、6連勤、7連勤・・・と、それぞれ連勤があるかないかをチェックをしたいのですが、5連勤以上しか見ることができず、6連勤があっても5連勤もありになってしまいます。関数でこうした処理は不可能でしょうか?
マクロもChatGPTと一緒に頑張ってみたんですが、こちらの伝え方が悪いのかどうがんばっても重複処理をしてしまいます。
それぞれの連勤回数を出力するようにできないでしょうか?
Sub CountConsecutive()
Dim dataRange As Range
Dim cell As Range
Dim consecutiveCount As Integer
Dim output5Consecutive As Range
Dim output6Consecutive As Range
Dim output7Consecutive As Range
Dim output8Consecutive As Range
Dim output9Consecutive As Range
Dim output10Consecutive As Range
Dim set5ConsecutiveCount As Integer
Dim set6ConsecutiveCount As Integer
Dim set7ConsecutiveCount As Integer
Dim set8ConsecutiveCount As Integer
Dim set9ConsecutiveCount As Integer
Dim set10ConsecutiveCount As Integer
Dim isConsecutive As Boolean
Dim ignoreCounts As Collection
Dim ignoreCount As Integer
' データの範囲を指定(F5:AJ5に合わせて変更)
Set dataRange = Range("F5:AJ5")
' 5回連続の結果を出力するセルを指定(AY7に合わせて変更)
Set output5Consecutive = Range("AY7")
' 6回連続の結果を出力するセルを指定(AZ7に合わせて変更)
Set output6Consecutive = Range("AZ7")
' 初期化
consecutiveCount = 0
set5ConsecutiveCount = 0
set6ConsecutiveCount = 0
set7ConsecutiveCount = 0
set8ConsecutiveCount = 0
set9ConsecutiveCount = 0
set10ConsecutiveCount = 0
isConsecutive = False
Set ignoreCounts = New Collection
' データを順に確認
For Each cell In dataRange
If cell.value = "出勤" Then
consecutiveCount = consecutiveCount + 1
isConsecutive = True
Else
If isConsecutive Then
' 10回以上連続の場合は無視
If consecutiveCount >= 10 Then
ignoreCount = 10
Else
' 5回以上連続の場合
If consecutiveCount >= 5 And Not Contains(ignoreCounts, consecutiveCount) Then
set5ConsecutiveCount = set5ConsecutiveCount + 1
ignoreCounts.Add consecutiveCount
End If
' 6回以上連続の場合
If consecutiveCount >= 6 And Not Contains(ignoreCounts, consecutiveCount) Then
set6ConsecutiveCount = set6ConsecutiveCount + 1
ignoreCounts.Add consecutiveCount
End If
Then
set10ConsecutiveCount = set10ConsecutiveCount + 1
ignoreCounts.Add consecutiveCount
End If
End If
isConsecutive = False
consecutiveCount = 0
End If
End If
Next cell
' データ範囲の最後で5回以上連続している場合
If consecutiveCount >= 5 And Not Contains(ignoreCounts, consecutiveCount) Then
set5ConsecutiveCount = set5ConsecutiveCount + 1
ignoreCounts.Add consecutiveCount
End If
' データ範囲の最後で6回以上連続している場合
If consecutiveCount >= 6 And Not Contains(ignoreCounts, consecutiveCount) Then
set6ConsecutiveCount = set6ConsecutiveCount + 1
ignoreCounts.Add consecutiveCount
End If
' 結果を出力
output5Consecutive.value = "5回以上連続:" & set5ConsecutiveCount & "セット"
output6Consecutive.value = "6回以上連続:" & set6ConsecutiveCount & "セット"
End Sub
Function Contains(col As Collection, value As Variant) As Boolean
On Error Resume Next
Contains = (col.Item(value) <> 0)
On Error GoTo 0
End Function
A 回答 (7件)
- 最新から表示
- 回答順に表示
No.1
- 回答日時:
マクロくまなくても条件付き書式でできますよ。
ちょっと画像が小さすぎて座標が読めないんですけど
その出勤を記入するセル範囲全体を選択して
数式としては 仮に範囲がD2から始まるなら
=COUNTIF(D2:H2,"出勤")=5
これは5連勤の先頭セルを色付けします。
D2:H2は横に5個ならぶ範囲なので
6連勤の場合はD2:I2になります。
同様に6連勤、7連勤と色を変えて設定して
その判断の順序を長いものから先に判断するように並べます。
試して頂けませんか?
丁寧な回答ありがとうございます。
やってみたらおっしゃる通りの結果が帰ってきました。
画像も荒くて申し訳ないです。
非常に厚かましいのですが、重ねて教えてもらってもいいでしょうか。
教えていただいた関数だと、範囲内に5連勤と4連勤があったら、間に空白があっても10連勤とカウントされてしまうのですが、例えば使用している環境だとF5:AJ5に31日分の出欠が入っていて、F5:J5に出勤、K5:M5に休、N5:S5に出勤と入っていた場合、5連勤と6連勤があると思うのですが、これをAY5に5連勤あり、AZ5に6連勤ありと表示させるようなことはできますでしょうか。
No.2
- 回答日時:
こんにちは
>関数でこうした処理は不可能でしょうか?
可能とは思いますが、かなり面倒な計算になりそうに思います。
多分、VBAを利用する方が簡単ではないでしょうか。
一方で、ご提示の図は読解できない上に、機能しないコードを見せられても、何をどうしたいのかさっぱりわかりません。
勝手に解釈して、
「1行の連続範囲内で、指定文字が連続して出現する最大数を数える」
ということと解釈しました。
意味が違っている場合は、以下は無視してください。
以下の、ユーザ定義関数で可能と思います。
(事前に、標準モジュールにコピペしておいてください)
使い方は
=countC(セル範囲、指定文字)
となります。
※ セル範囲は、1行分の連続セル範囲とします。
Function countC(ByRef r As Range, ByRef s) As Long
Dim i As Long, j As Long, n As Long
Dim v
v = r.Rows(1).Cells.Value
For i = 1 To UBound(v, 2)
n = 0
For j = i To UBound(v, 2)
If v(1, j) = s Then n = n + 1 Else Exit For
Next j
v(1, i) = n
Next i
countC = Application.Max(v)
End Function
分かりづらい質問内容なうえに、画像も適当で申し訳ありません。
やりたいことは、1か月の出勤日の中に、5連勤以上の勤務がそれぞれ何回あるかを数えたいというものでした。
教えていただいたコードを参考にさせていただきます。
ありがとうございました。
No.3
- 回答日時:
>画像みたいな感じで、5連勤、6連勤、7連勤・・・と、それぞれ連勤があるかないかをチェックをしたいのですが
範囲に5連勤がいくつ6連勤がいくつ・・・って事かな?
出力1セルみたいですけれど・・・最大連勤数なら#2様が回答されていますので 以下は読み飛ばしてください
画像が良く見えないのでコードの使用アドレスから想像して
AIのコードを添削するのはしんどそうなので
勝手な解釈で 新しく書くと
FIDで探してAreaを取得Areaの大きさで連続セルとして条件 カウント
範囲を変えるかもしれないのでPrivate Functionとして 出力をAY7から
右に5連勤・・8連勤回数
Case 5 が 5連勤 ブロックの処理 n5はカウント変数
.ColorIndex = で セルの色設定(コメント化で実行されないです)
Private Function CountConsecutive_1の戻り値は配列
CountConsecutive_1 = Array(n5, n6, n7, n8)
可変もできますが、とりあえず4つにしています
呼び出しや上記を条件に合わせて変更してください
とりあえず
一例のサンプル
Sub test()
Dim ans As Variant
ans = CountConsecutive_1(Range("F5:AJ5"), "出勤")
Range("AY7").Resize(, UBound(ans) + 1).Value = ans
End Sub
Private Function CountConsecutive_1(rng As Range, fdKey As String) As Variant()
Dim target As Range
Dim firstAddress As String
Dim getRng As Range
Set target = rng.Find(What:=fdKey, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
After:=rng(rng.Count), _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
MatchByte:=False)
If target Is Nothing Then
'MsgBox "出勤はヒットしませんでした"
Else
firstAddress = target.Address
Set getRng = target
Do
Set getRng = Union(getRng, rng.FindNext(target))
Set target = rng.FindNext(target)
If target Is Nothing Then Exit Do
Loop While target.Address <> firstAddress
End If
Dim i As Integer
Dim n5 As Integer, n6 As Integer, n7 As Integer, n8 As Integer
For i = 1 To getRng.Areas.Count
Select Case getRng.Areas(i).Count
Case 5
'getRng.Areas(i).Interior.ColorIndex = 33
n5 = n5 + 1
Case 6
'getRng.Areas(i).Interior.ColorIndex = 6
n6 = n6 + 1
Case 7
'getRng.Areas(i).Interior.ColorIndex = 3
n7 = n7 + 1
Case 8
'getRng.Areas(i).Interior.ColorIndex = 39
n8 = n8 + 1
End Select
Next
CountConsecutive_1 = Array(n5, n6, n7, n8)
End Function
こんなにわかりづらいコードだったのに、的確な回答ありがとうございます。
期待通りの結果が出ました。
10連勤があると、9連勤もカウントされてしまうのですが、ここからはいただいたコードを参考にさせていただいて、自力で頑張ってみます。
本当にありがとうございました。
No.4
- 回答日時:
No1です。
私は関数を回答した覚えはありませんし連勤開始セルに色がつくから座標も明白です。
返答の位置を誤っておられませんか?
条件付き書式は試して頂けないのでしょうか?
すみません、一番最初に返事させていただいたのですが、条件付き書式でも試させていただきました。
おっしゃる通りの結果が帰ってきました。
ありがとうございます。
No.5
- 回答日時:
No2です。
>1か月の出勤日の中に、5連勤以上の勤務がそれぞれ何回あるかを数えたいというものでした。
えぇと・・・
例えば、連続勤務のブロックが、「3連勤、5連勤、7連勤、6連勤」とあった際に、
5連勤以上は3ブロックなので3を求めたいのか、あるいは、7連勤の内部を見ると初日から見れば7連勤、二日目から見れば6連勤・・なので7連勤内で5以上は3日、全体では6日として6を求めたいのかどちらなんでしょうね?
No2の関数内部で、vにはそれぞれの日から数えた連勤数が得られていますので、前者の数え方であれば5が何個あるか、後者の数え方であれば5以上が何個あるかを数えれば求められます。
COUNTIF関数で求められるかと思いましたが、COUNTIFで配列は使えないようなので、直接ループで数える方法にして追加修正してみました。
併せて、数えたい連勤数も指定できるように引数として追加してあります。
=countc(セル範囲, 指定文字列, 指定連続数)
で求められます。
以下は、上記のうちの前者のカウント方法での例です。
(セル範囲の行数は1行という前提は同じままです。)
Function countC(ByRef r As Range, ByRef s, ByRef c As Long) As Long
Dim i As Long, j As Long, n As Long
Dim v
v = r.Rows(1).Cells.Value
For i = 1 To UBound(v, 2)
n = 0
For j = i To UBound(v, 2)
If v(1, j) = s Then n = n + 1 Else Exit For
Next j
v(1, i) = n
Next i
countC = 0
For i = 1 To UBound(v, 2)
If v(1, i) = c Then countC = countC + 1
Next i
End Function
※ 後者のカウント方法にしたければ、cで判定しているカウント数を、c以上でカウントすれば求められます。
No.6
- 回答日時:
#3です
>10連勤
連勤は例えなのでしょうけれど 黒いですねW
出力セルがAY7→5,6,7・・・ならば
5以上の連勤を連勤ごとの回数を全て出す セルの色とかもいらないのなら
Select Caseは不要ですね
>自力で頑張ってみます
全部VBAで処理する場合、分かり難い書き方をしてしまいましたので ちょっと添削(余計分かり難くなってればごめんなさい)
Set dataRng = Range("F5:AJ5") データ範囲
Set output5 = Range("AY7") 5連勤を出力セル
Range("F5:AJ10")とすると1行ずつ処理 出力は相対位置に出力
少しまとめた方が良いかもですが ステップ実行やdebug.Print
変数のtargetArea.Selectなどを差し込んで確認すると良いかも
自力でとの事なので余計なお世話ですが 一例の参考程度に
Sub test()
Const minimum As Integer = 5
Const kWord As String = "出勤"
Dim dataRng As Range
Set dataRng = Range("F5:AJ5")
Dim output5 As Range
Set output5 = Range("AY7")
Dim ans As Variant
Dim c As Long, r As Long
c = output5.Column - dataRng(dataRng.Columns.Count).Column
r = output5.Row - dataRng(1).Row
Dim targetArea As Range
Dim i As Long
For i = 1 To dataRng.Rows.Count
Set targetArea = dataRng.Areas(i)
ans = CountConsecutive_1(targetArea, kWord, minimum)
On Error Resume Next
targetArea.Item(targetArea.Count).Offset(r, c).Resize(, UBound(ans) + 1).Value = ans
Next
End Sub
Private Function CountConsecutive_1(rng As Range, Fdkey As String, minimum As Integer) As Variant()
Dim target As Range
Dim firstAddress As String
Dim getRng As Range
Set target = rng.Find(What:=Fdkey, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
After:=rng(rng.Count), _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
MatchByte:=False)
If target Is Nothing Then
'MsgBox "出勤はヒットしませんでした"
Else
firstAddress = target.Address
Set getRng = target
Do
Set getRng = Union(getRng, rng.FindNext(target))
Set target = rng.FindNext(target)
If target Is Nothing Then Exit Do
Loop While target.Address <> firstAddress
End If
Dim i As Integer, n As Integer
Dim x As Integer, arr()
For i = 1 To getRng.Areas.Count
If n < getRng.Areas(i).Count Then n = getRng.Areas(i).Count
Next
If n >= minimum Then
ReDim arr(0 To n - minimum)
Else
'MsgBox minimum & "連勤以上はヒットしませんでした"
Exit Function
End If
For i = 1 To getRng.Areas.Count
x = getRng.Areas(i).Count - minimum
If x >= 0 Then
arr(x) = arr(x) + 1
End If
Next
CountConsecutive_1 = arr
End Function
No.7
- 回答日時:
連投すみません
Functionで配列を返しています
As Variant型なので初期値はEmptyで 0が返りません
0を出力したい場合はFunctionの戻り型とFunction内の一時受けの変数の型を数値型に変更してください(IntegerまたはLong)
Private Function CountConsecutive_1(rng As Range, Fdkey As String, minimum As Integer) As Integer()
Dim x As Integer, arr() As Integer
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Excel vbaについての質問 3 2023/04/18 16:14
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Visual Basic(VBA) エクセルマクロで出力行の増やし方がわかりません。 4 2023/09/28 23:40
- Visual Basic(VBA) wordのマクロで思うように行きません(ファイル削除ができない) 3 2023/09/12 08:34
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Visual Basic(VBA) ワークシートチェンジ 1 2022/02/01 11:19
- Visual Basic(VBA) VBAに関して 2 2023/11/09 20:57
このQ&Aを見た人はこんなQ&Aも見ています
-
風水の観点で選ぶ観葉植物とは?置き場所や上げたい運気ごとの注意点を紹介!
観葉植物で運気をアップするコツを、風水デザイン1級建築士の福島昌彦さんに伺った。
-
エクセルで⑤番の操作が分かりません。どういう関数が良いんですか?
Excel(エクセル)
-
エクセル→貼り付けのオプション→貼り付け先の書式に合わせる が急にできなくなった。 どうして?
Excel(エクセル)
-
DBCS関数とは何ぞやッ!
Excel(エクセル)
-
-
4
Excelで【1-11】と入力すると【1月11日】になってしまう
Excel(エクセル)
-
5
EXCEL表の手入力を関数で自動化したい
Excel(エクセル)
-
6
エクセルで、複数のマスに構文を一度に入力する方法を教えてください
Excel(エクセル)
-
7
当番表の作成について
Excel(エクセル)
-
8
EXCELの計算式のコピーについてのしつもんです。 10万件以上の支店が縦にずらっと続いています。
Excel(エクセル)
-
9
曜日を判定して、曜日ごとに特定セルに文字を入力するマクロを教えて下さい
Excel(エクセル)
-
10
VBA(えくせる)ってなんでメンテできない人が多いんですか?
Excel(エクセル)
-
11
エクセルで リンクが切れない状態で文字を入れたい
Excel(エクセル)
-
12
Excelで、改行がある場合の条件式(関数)の書き方を教えてください
Excel(エクセル)
-
13
エクセルで、小数点以下がないときに小数点を表示させない方法 +語尾に「(半角スペース)%」
Excel(エクセル)
-
14
エクセル 数値の10を10月と認識するにはどうすればいいですが?
Excel(エクセル)
-
15
別シートに成約をボタン1つで転記したい
Excel(エクセル)
-
16
excelについて。
Excel(エクセル)
-
17
ExcelのVBAのことで質問です。 以下のコードを入れ、ボタンを押せば作動させると写真のように画面
Visual Basic(VBA)
-
18
シフト表を自動でカレンダーに反映したい
Excel(エクセル)
-
19
excelのVBAについて、以下のコードに追加をお願いいたします。
Visual Basic(VBA)
-
20
Excel関数かなにかでスムーズに処理するにはあなたならどうしますか?
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
like句を使って日本語を検索す...
-
XAMPPでMySQLで文字化け、文字...
-
windows上のphpにおける全角ハ...
-
接続ができません
-
シングルクォーテーションとダ...
-
副問合せにLIKE文を使う方法は...
-
phpAdminを導入したのですが。
-
旧filemakerで和暦(令和など)...
-
ERROR 1045 (28000) (using pas...
-
VBAで変数内に保持された二次配...
-
ACCESSとXサーバーをODBCで接続...
-
二進数を勉強しているのですが...
-
SQLのVARCHARとVARCHAR2の違い
-
mysql(mariaDB)の格納文字数は...
-
INT型は金額の型に使用するべき...
-
経過時間(hhmmdd)をDATE型には...
-
MySQLにリモートホストから接続...
-
mysql_real_escape_string?
-
PHPでMySQLテーブルロック一覧取得
-
テーブル作成でエラーが出てき...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
like句を使って日本語を検索す...
-
my.cnf と my.ini の違い
-
エクセルで連勤チェックをした...
-
ODBC接続で全角文字が文字化け
-
windows上のphpにおける全角ハ...
-
phpMyadminでのMySQLの文字セット
-
netscreen remoteに関して
-
phpMyAdminのデフォルトのLangu...
-
文字コード変更
-
MYSQLの文字化けについて
-
接続ができません
-
SQLのVARCHARとVARCHAR2の違い
-
副問合せにLIKE文を使う方法は...
-
ODP.NETのバージョン確認
-
ERROR 1045 (28000) (using pas...
-
VBAで変数内に保持された二次配...
-
MySQLカラム名は日本語と英数字...
-
INT型は金額の型に使用するべき...
-
プライマリーキーの昇順でソー...
-
Float型の時の計算結果がおかしい
おすすめ情報