Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

9593 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【26255】表出回数を平均化するには にしもり 05/6/29(水) 17:12

【26268】Re:表出回数を平均化するには ponpon 05/6/30(木) 0:11

【26292】Re:表出回数を平均化するには にしもり 05/6/30(木) 17:21

【26294】Re:表出回数を平均化するには にしもり 05/6/30(木) 17:37

【26301】Re:表出回数を平均化するには ponpon 05/6/30(木) 23:04

【26308】Re:表出回数を平均化するには 小僧 05/7/1(金) 9:56

【26311】Re:表出回数を平均化するには にしもり 05/7/1(金) 10:40

【26323】Re:○の数を平準化するには にしもり 05/7/1(金) 13:57

【26367】Re:○の数を平準化するには ponpon 05/7/2(土) 22:25

【26405】Re:○の数を平準化するには にしもり 05/7/4(月) 15:56

【26415】Re:○の数を平準化するには ponpon 05/7/4(月) 20:13

【26435】Re:○の数を平準化するには にしもり 05/7/5(火) 15:21

【26461】Re:○の数を平準化するには ponpon 05/7/6(水) 0:23

【26467】Re:○の数を平準化するには にしもり 05/7/6(水) 10:10

【26475】Re:○の数を平準化するには 小僧 05/7/6(水) 13:52

【26526】Re:○の数を平準化するには にしもり 05/7/7(木) 20:28


	【26255】表出回数を平均化するには

にしもり - 05/6/29(水) 17:12 -


	引用なし

	パスワード

以前アドバイスをいただいて作成した、シフト表をリバイスしています。
ある程度自力でできましたが、できない点があります。
シフト表のF列には人の名が繰り返し出てきます。
その左隣のE列目に、次の規則にのっとって○をつけたいのです。

まず、E3,E11,E16,E21に○をつけます。
人ごとに表出回数をカウントし、F3,F11,F16,F21の人に１ポイント追加します。
次に、E26,E34,E39,E44に○をつけるのですがその際に、
F26に在る人名のカウントがF27に在る人名のカウントより大きかったら、E26でなくE27に○をつけ、
F34に在る人名のカウントがF35に在る人名のカウントより大きかったら、E34でなくE35に○をつけ、
F39に在る人名のカウントがF40に在る人名のカウントより大きかったら、E39でなくE40に○をつけ、
F44に在る人名のカウントがF45に在る人名のカウントより大きかったら、E44でなくE45に○をつけます。

そのように531行まで繰り返し、結果、人ごとのカウントが可能な限り均等になる
ようにしたいのですが、どのようなロジックを追加すればよいかわからず壁にぶつかっています。
どなたかご教示くださいませんでしょうか。

Sub test2()

　　Dim v As Variant
　　Dim lc As Long
　　Dim r As Long
　　Dim i As Long
　　Dim k As Long
　　Const lr As Long = 531
　　Dim rag As Range, FRw As Long
　　

　　With ActiveSheet
　　　　If .Name = "営業日" Then
　　　　　　MsgBox "シフト表をアクティブにして実行する事。", 64
　　　　　　Exit Sub
　　　　End If
　　　　Application.ScreenUpdating = False
　　　　r = 3
　　　　i = 1
　　　　k = 1
　　　　m = 6
　　　　Do While r <= lr
　　　　　　Select Case False
　　　　　　　　Case r Mod 23 = 11 Or r Mod 23 = 16
　　　　　　　　　　v = Worksheets("人員").Range("A2:A30").Value
　　　　　　　　　　.Cells(r, 6).Value = v(i, 1)
　　　　　　　　　　i = i + 1
　　　　　　　　　　If i > 29 Then i = 1
　　　　　　　　　　r = r + 1
　　　　　　　　Case Else
　　　　　　　　　　v = Worksheets("人員").Range("B2:B5").Value
　　　　　　　　　　.Cells(r, 6).Value = v(k, 1)
　　　　　　　　　　k = k + 1
　　　　　　　　　　If k > 4 Then k = 1
　　　　　　　　　　r = r + 1
　　　　　
　　　　　　End Select
　　　　Loop
　　　　Application.ScreenUpdating = True
　　End With
　　
End Sub


	【26268】Re:表出回数を平均化するには

ponpon - 05/6/30(木) 0:11 -


	引用なし

	パスワード

こんばんは。
よく分からないのですが・・・
質問の通りにやってみました。マクロの記録なみです。
他にうまい方法を思いつきませんでした。
作業列をＩ列にしていますので、都合が悪ければ変えてください。

Sub test()
　Dim myR As Range
　Dim myRow As Long
　Dim c As Range
　Dim myAry As Variant
　Dim i As Long
　
　
　Application.ScreenUpdating = False

　'ワークシート関数CountIfで各氏名の表出をカウントする。
　Set myR = Range("F1", Range("F65536").End(xlUp))
　myRow = Range("F65536").End(xlUp).Row
　With myR.Offset(0, 3)
　　 .Value = "=CountIf($F$1:$F$" & myRow & ", F1)"
　　 .Value = .Value
　End With
　
　'E列の値を消す
　Range("E:E").ClearContents
　
　'F3,F11,F16,F21の人に１ポイント追加し、
　myAry = Array(Range("F3").Value, Range("F11").Value, Range("F16").Value, Range("F21").Value)
　For i = 0 To 3
　 For Each c In myR
　　　 If c.Value = myAry(i) Then
　　　　 With c
　　　　　 .Offset(0, 3).Value = .Offset(0, 3).Value + 1
　　　　 End With
　　　 End If
　　Next
　 Next

　'E3 , E11, E16, E21に○をつける
　Range("E3 , E11, E16, E21").Value = "○"
　
　'E26に○をつける
　 With Cells(26, 5)
　　 If .Offset(0, 4).Value > .Offset(1, 4).Value Then
　　　　.Offset(1, 0).Value = "○"
　　 Else
　　　　.Value = "○"
　　 End If
　 End With
　
　 'E34,E39,E44・・・・に○をつける
　 For i = 34 To 531 Step 5
　　 With Cells(i, 5)
　　　 If .Offset(0, 4).Value > .Offset(1, 4).Value Then
　　　　　.Offset(1, 0).Value = "○"
　　　 Else
　　　　　.Value = "○"
　　　 End If
　　 End With
　 Next
　
　'作業列の値を消す。
　myR.Offset(0, 3).ClearContents
　Application.ScreenUpdating = True

End Sub


	【26292】Re:表出回数を平均化するには

にしもり - 05/6/30(木) 17:21 -


	引用なし

	パスワード

▼ponpon さん：
アドバイスを参考にさせていただき、やりたいことに一歩近づくことができました。
またしても変更しなければいけない点がでてきたのですが、整理してから質問します。
とりあえずどうもありがとうございました。

Sub test()

　　Dim myR As Range
　　Dim myRow As Long
　　Dim c As Range
　　Dim myAry As Variant
　　Dim i As Long
　　
　　Dim v As Variant
　　Dim lc As Long
　　Dim r As Long
　　Dim m As Long
　　Dim s As Long
　　Dim t As Long
　　Dim u As Long
　　Dim w As Long
　　
　　Dim k As Long
　　Const lr As Long = 531
　　Dim rag As Range, FRw As Long
　
　　With ActiveSheet
　　　　If .Name = "営業日" Then
　　　　　　MsgBox "シフト表をアクティブにして実行する事。", 64
　　　　　　Exit Sub
　　　　End If
　　　　Application.ScreenUpdating = False
　　　　r = 3
　　　　i = 1
　　　　k = 1
　　　　m = 6
　　　　Do While r <= lr
　　　　　　Select Case False
　　　　　　　　Case r Mod 23 = 11 Or r Mod 23 = 16
　　　　　　　　　　v = Worksheets("人員").Range("A2:A30").Value
　　　　　　　　　　.Cells(r, 6).Value = v(i, 1)
　　　　　　　　　　i = i + 1
　　　　　　　　　　If i > 29 Then i = 1
　　　　　　　　　　r = r + 1
　　　　　　　　Case Else
　　　　　　　　　　v = Worksheets("人員").Range("B2:B5").Value
　　　　　　　　　　.Cells(r, 6).Value = v(k, 1)
　　　　　　　　　　k = k + 1
　　　　　　　　　　If k > 4 Then k = 1
　　　　　　　　　　r = r + 1
　　　　　
　　　　　　End Select
　　　　Loop
　　　　Application.ScreenUpdating = True
　　End With

　Application.ScreenUpdating = False

　'ワークシート関数CountIfで各氏名の表出をカウントする。
　Set myR = Range("F1", Range("F65536").End(xlUp))
　myRow = Range("F65536").End(xlUp).Row
　With myR.Offset(0, 3)
　　 .Value = "=CountIf($F$1:$F$" & myRow & ", F1)"
　　 .Value = .Value
　End With

　'E列の値を消す
　Range("E3:E65536").ClearContents

　'F3,F11,F16,F21の人に１ポイント追加し、
　myAry = Array(Range("F3").Value, Range("F11").Value, Range("F16").Value, Range("F21").Value)
　For i = 0 To 3
　 For Each c In myR
　　　 If c.Value = myAry(i) Then
　　　　 With c
　　　　　 .Offset(0, 3).Value = .Offset(0, 3).Value + 1
　　　　 End With
　　　 End If
　　Next
　 Next

　'E3 , E11, E16, E21に○をつける
　Range("E3 , E11, E16, E21").Value = "○"

　'E26･･･に○をつける
　　For s = 26 To 531 Step 23
　　　　 With Cells(s, 5)
　　　　 If .Offset(0, 4).Value > .Offset(1, 4).Value Then
　　　　　　.Offset(1, 0).Value = "○"
　　　　 Else
　　　　　　.Value = "○"
　　　　 End If
　　　 End With
　　Next
　
　'E34･･･に○をつける
　　For t = 34 To 531 Step 23
　　　　 With Cells(t, 5)
　　　　 If .Offset(0, 4).Value > .Offset(1, 4).Value Then
　　　　　　.Offset(1, 0).Value = "○"
　　　　 Else
　　　　　　.Value = "○"
　　　　 End If
　　　 End With
　　Next
　　　
　
　'E39･･･に○をつける
　　For u = 39 To 531 Step 23
　　　　 With Cells(u, 5)
　　　　 If .Offset(0, 4).Value > .Offset(1, 4).Value Then
　　　　　　.Offset(1, 0).Value = "○"
　　　　 Else
　　　　　　.Value = "○"
　　　　 End If
　　　 End With
　　Next
　　　
　
　'E44･･･に○をつける
　　For w = 44 To 531 Step 23
　　　　 With Cells(w, 5)
　　　　 If .Offset(0, 4).Value > .Offset(1, 4).Value Then
　　　　　　.Offset(1, 0).Value = "○"
　　　　 Else
　　　　　　.Value = "○"
　　　　 End If
　　　 End With
　　Next
　

　'作業列の値を消す。
　myR.Offset(0, 3).ClearContents
　Application.ScreenUpdating = True

End Sub


	【26294】Re:表出回数を平均化するには

にしもり - 05/6/30(木) 17:37 -


	引用なし

	パスワード

また質問させていただきます。

下記はプログラムの一部分です。
このままですと、11,16,34,39,57,62,80,85,103,108,126,131,149,154,
172,177,195,200,218,223,241,246,264,269,287,292,310,315,333,338,
356,361,379,384,402,407,425,430,448,453,471,476,494,499,517,522行目は、case No2に入り、人員のB2:B5から持ってきてしまいます。
ですが、80,85,172,177,264,269,356,361,448,453行目は、
case No1に入るようにしたいのです。
そのときどう書けばいいかわかりません。
どうかご教授ください。

　　　　r = 3
　　　　i = 1
　　　　k = 1
　　　　m = 6
　　　　Do While r <= lr
　　　　　　Select Case False
'case No1
　　　　　　　　Case r Mod 23 = 11 Or r Mod 23 = 16
　　　　　　　　　　v = Worksheets("人員").Range("A2:A30").Value
　　　　　　　　　　.Cells(r, 6).Value = v(i, 1)
　　　　　　　　　　i = i + 1
　　　　　　　　　　If i > 29 Then i = 1
　　　　　　　　　　r = r + 1
'case No2
　　　　　　　　Case Else
　　　　　　　　　　v = Worksheets("人員").Range("B2:B5").Value
　　　　　　　　　　.Cells(r, 6).Value = v(k, 1)
　　　　　　　　　　k = k + 1
　　　　　　　　　　If k > 4 Then k = 1
　　　　　　　　　　r = r + 1
　　　　　
　　　　　　End Select
　　　　Loop


	【26301】Re:表出回数を平均化するには

ponpon - 05/6/30(木) 23:04 -


	引用なし

	パスワード

こんばんは。
コードはよくは見てないので分かりませんが、
長々と長いプログラムにするより、subプロシージャとして
呼び出すようにした方がわかりやすいし、後でのメインテもやりやすいと思います。

sub　main
　call　シフト表
　call　表出の平均化
　call　・・・・・
End　sub

sub　シフト表()
　　なんたらかんたら

End sub

sub 表出の平均化()
　　なんたらかんたら
End sub

sub ・・・・（）
　　なんたらかんたら
End　sub

今日は時間がないので・・・これにて失礼します。

↑上の質問は、よく意味が分かりません。
　コードだけでなく何がしたいのかが分かれば、アドバイスの
　しようがあるかもしれません。
　たとえば、どうしてそのようにselect　caseに分けたのか
　他の人には分からないと思います。　


	【26308】Re:表出回数を平均化するには

小僧 - 05/7/1(金) 9:56 -


	引用なし

	パスワード

▼にしもりさん、ponpon さん：
おはようございます。

こんな感じでしょうか？

　　　　Select Case r Mod 92
　　　　　　Case 11, 16, 34, 39, 57, 62
　　　　　　　　 'No2処理
　　　　　　Case Else
　　　　　　　　 'No1処理
　　　　End Select


	【26311】Re:表出回数を平均化するには

にしもり - 05/7/1(金) 10:40 -


	引用なし

	パスワード

▼ponponさん、小僧さん：
アドバイスを参考に下記のようにしたら、できました。
Select Caseの直後にMod xxと書けるのですね。
また、別の質問がありますが、整理してから投稿するように致します。
とりあえずどうもありがとうございました。

　　　　r = 3
　　　　i = 1
　　　　k = 1
　　　　m = 6
　　　　Do While r <= lr
　　　　　　Select Case r Mod 92

　　　　　　Case 11, 16, 34, 39, 57, 62
　　　　　　　　　　v = Worksheets("人員").Range("B2:B5").Value
　　　　　　　　　　.Cells(r, 6).Value = v(k, 1)
　　　　　　　　　　k = k + 1
　　　　　　　　　　If k > 4 Then k = 1
　　　　　　　　　　r = r + 1
　　　　　
　　　　　　Case Else
　　　　　　　　　　v = Worksheets("人員").Range("A2:A30").Value
　　　　　　　　　　.Cells(r, 6).Value = v(i, 1)
　　　　　　　　　　i = i + 1
　　　　　　　　　　If i > 29 Then i = 1
　　　　　　　　　　r = r + 1

　　　　　　End Select
　　　　Loop


	【26323】Re:○の数を平準化するには

にしもり - 05/7/1(金) 13:57 -


	引用なし

	パスワード

ponponさんにお詫びですが、表出した人名の数カウントするという表現は正確でなく、人名に応じた○の数をカウントするというのが正確でした。もうしわけありませんでした。

やりたいことを正確に書きます。

まず、無条件に4箇所(E3,E11,E16,E21)に○をつけます。
その直後にF3の人名をカウンタとして使って+1し、
F11の人名をカウンタとして使って+1し、
F16の人名をカウンタとして使って+1し、
F21の人名をカウンタとして使って+1します。

その後、以下のパターンが続きます。
F26からF33の人名カウンタうち最も小さいE列のセルに○をつけ、かつ、
その人名カウンタに+1し、
F34からF38の人名カウンタうち最も小さいE列のセルに○をつけ、かつ、
その人名カウンタに+1し、
F39からF43の人名カウンタうち最も小さいE列のセルに○をつけ、かつ、
その人名カウンタに+1し、
F44からF48の人名カウンタうち最も小さいE列のセルに○をつけ、かつ、
その人名カウンタに+1します。

F49からF56の人名カウンタうち最も小さいE列のセルに○をつけ、かつ、
その人名カウンタに+1し、
F57からF61の人名カウンタうち最も小さいE列のセルに○をつけ、かつ、
その人名カウンタに+1し、
F62からF66の人名カウンタうち最も小さいE列のセルに○をつけ、かつ、
その人名カウンタに+1し、
F67からF71の人名カウンタうち最も小さいE列のセルに○をつけ、かつ、
その人名カウンタに+1します。

・・・このパターンが531行目に達するまで続きます。

このようにして人名に応じた○の数をなるべく平準化したいのです。
どう書けばよいかご教示ください。

Sub test()

　　Dim myR As Range
　　Dim myRow As Long
　　Dim c As Range
　　Dim myAry As Variant
　　Dim i As Long
　　
　　Dim v As Variant
　　Dim lc As Long
　　Dim r As Long
　　Dim m As Long
　　Dim s As Long
　　Dim t As Long
　　Dim u As Long
　　Dim w As Long
　　
　　Dim k As Long
　　Const lr As Long = 531
　　Dim rag As Range, FRw As Long
　　
　　With ActiveSheet
　　　　If .Name = "営業日" Then
　　　　　　MsgBox "シフト表をアクティブにして実行する事。", 64
　　　　　　Exit Sub
　　　　End If
　　　　Application.ScreenUpdating = False
　　　　r = 3
　　　　i = 1
　　　　k = 1
　　　　m = 6
　　　　Do While r <= lr
　　　　　　Select Case r Mod 92

　　　　　　Case 11, 16, 34, 39, 57, 62
　　　　　　　　　　v = Worksheets("人員").Range("B2:B5").Value
　　　　　　　　　　.Cells(r, 6).Value = v(k, 1)
　　　　　　　　　　k = k + 1
　　　　　　　　　　If k > 4 Then k = 1
　　　　　　　　　　r = r + 1
　　　
　　　　　　Case Else
　　　　　　　　　　v = Worksheets("人員").Range("A2:A30").Value
　　　　　　　　　　.Cells(r, 6).Value = v(i, 1)
　　　　　　　　　　i = i + 1
　　　　　　　　　　If i > 29 Then i = 1
　　　　　　　　　　r = r + 1

　　　　　　End Select
　　　　Loop
　　　　Application.ScreenUpdating = True
　　End With

　Application.ScreenUpdating = False

　'ワークシート関数CountIfで各氏名の表出をカウントする。
　Set myR = Range("F1", Range("F65536").End(xlUp))
　myRow = Range("F65536").End(xlUp).Row
　With myR.Offset(0, 3)
　　 .Value = "=CountIf($F$1:$F$" & myRow & ", F1)"
　　 .Value = .Value
　End With

　'E列の値を消す
　Range("E3:E65536").ClearContents

　'F3,F11,F16,F21の人に１ポイント追加し、
　myAry = Array(Range("F3").Value, Range("F11").Value, Range("F16").Value, Range("F21").Value)
　For i = 0 To 3
　 For Each c In myR
　　　 If c.Value = myAry(i) Then
　　　　 With c
　　　　　 .Offset(0, 3).Value = .Offset(0, 3).Value + 1
　　　　 End With
　　　 End If
　　Next
　 Next

　'E3 , E11, E16, E21に○をつける
　Range("E3 , E11, E16, E21").Value = "○"

　'E26に○をつける
　　For s = 26 To 531 Step 23
　　　　 With Cells(s, 5)
　　　　 If .Offset(0, 4).Value > .Offset(1, 4).Value Then
　　　　　　.Offset(1, 0).Value = "○"
　　　　 Else
　　　　　　.Value = "○"
　　　　 End If
　　　 End With
　　Next
　
　'E34に○をつける
　　For t = 34 To 531 Step 23
　　　　 With Cells(t, 5)
　　　　 If .Offset(0, 4).Value > .Offset(1, 4).Value Then
　　　　　　.Offset(1, 0).Value = "○"
　　　　 Else
　　　　　　.Value = "○"
　　　　 End If
　　　 End With
　　Next
　　　
　
　'E39に○をつける
　　For u = 39 To 531 Step 23
　　　　 With Cells(u, 5)
　　　　 If .Offset(0, 4).Value > .Offset(1, 4).Value Then
　　　　　　.Offset(1, 0).Value = "○"
　　　　 Else
　　　　　　.Value = "○"
　　　　 End If
　　　 End With
　　Next
　　　
　
　'E44に○をつける
　　For w = 44 To 531 Step 23
　　　　 With Cells(w, 5)
　　　　 If .Offset(0, 4).Value > .Offset(1, 4).Value Then
　　　　　　.Offset(1, 0).Value = "○"
　　　　 Else
　　　　　　.Value = "○"
　　　　 End If
　　　 End With
　　Next

　'作業列の値を消す。
　myR.Offset(0, 3).ClearContents
　Application.ScreenUpdating = True

End Sub


	【26367】Re:○の数を平準化するには

ponpon - 05/7/2(土) 22:25 -


	引用なし

	パスワード

こんばんは。
よくわからないので、
仕様がよくわかってないものですから、説明お願いします。

>その直後にF3の人名をカウンタとして使って+1し、
>F11の人名をカウンタとして使って+1し、
>F16の人名をカウンタとして使って+1し、
>F21の人名をカウンタとして使って+1します。
の意味がよくわかりません。

表出した人名の数カウントするのではないのなら、

<人名カウンタうち最も小さいE列のセル

というからには、それぞれに何らかの数がカウンタとしてカウントされているのでしょ？
F26以下の人名カウンタとは、何の数？

されようとされていることは、何となく理解できます。
>F26からF33
>F34からF38
・・・・
・・・・
の中で一番回数(どのように取得するかはわかりませんが、これがカウンタでしょう）
の少ない人に○をつけると言うことなんでしょうが・・・。
　そのカウンタというものを、どこかの列に表示していて、範囲を指定して、
Min関数を使えば、最小値がわかるので、その値を持つセルをofffsetして、
E列に○をつければよいと思いますが、
　人名カウンタの意味が私にはよくわかりません。
申し訳ありません。


	【26405】Re:○の数を平準化するには

にしもり - 05/7/4(月) 15:56 -


	引用なし

	パスワード

▼ponpon さん：
仕様をきめてからとりかかるという意識が希薄で申し訳ございません。
F3,F11,F16,F21に出てくる人名を山田さん鈴木さん岡野さん本田さんとします。
山田さん鈴木さん岡野さん本田さんはいずれも初出ですから、無条件にE列に○を付け、無条件に山田=山田+1 鈴木=鈴木+1 岡野=岡野+1 本田=本田+1とします。
問題なのはF26以下で、F26～F33の中でカウントがもっとも少ない人の中で一番上の行にでているひとに○をつけ、+１したいのです。
例：F26～F33がもし木村、佐伯、山田、高木、小川、長沢、小山、大木だったら、○をつけるのはカウントが一番多い山田ではなく、又、一番上の行にでている木村にしたいのです。
休み中に考えましたが規則性をプログラムに反映する力がありません。
このような仕様の説明でご理解いただけましたなら、何卒アドバイスよろしくお願いいたします。


	【26415】Re:○の数を平準化するには

ponpon - 05/7/4(月) 20:13 -


	引用なし

	パスワード

こんばんは。

>仕様をきめてからとりかかるという意識が希薄で申し訳ございません。
　私も過去手作業の表をそのままVBAでいじろうとしていろいろと苦労しました。
ループも一回ですむものを、学期別に表作成しているものですから、空白行があり
3回ループしないといけなくなったり、セルの結合をしていたために、
結果が思うとおりにならなかったりとさんざんでした。過去ログで調べてもらえば
わかると思いますが・・・

さて、本題ですが

>無条件に山田=山田+1 鈴木=鈴木+1 岡野=岡野+1 本田=本田+1とします。
やっぱりここがわかりません。
どこかの列にカウンタ列をもうけていて+1するということでしょうか？

>問題なのはF26以下で、F26～F33の中でカウントがもっとも少ない人
というからには、F26～F33の人はそれぞれ独自のカウントを持っているのでしょ？
それが、何のカウントなのかがわかりません。
○をつけるとどこかの列にカウントアップされるようにしているのでしょうか？

>F26～F33の中でカウントがもっとも少ない人の中で一番上の行にでているひとに
ということは、○をつけるとカウントが+1されるので、並べ替えをしなくてはなりませんね。そうすれば範囲内で、
いつも一番上の人に○をつけてカウントアップ　→　並べ替え　→一番上に○
となりますね。

とにかくカウンタが何の数なのかが、また、どこに記述または格納されているのか
私にはわかりません。
　もう少し説明してください。
初めは、全員０で、○を付けるとカウントが＋１されると言うことなんですか？
でもそれはシートのどこを見ればわかるのでしょう。


	【26435】Re:○の数を平準化するには

にしもり - 05/7/5(火) 15:21 -


	引用なし

	パスワード

▼ponpon さん：
ありがとうございます。
>どこかの列にカウンタ列をもうけていて+1するということでしょうか？
>というからには、F26～F33の人はそれぞれ独自のカウントを持っているのでしょ？
>○をつけるとどこかの列にカウントアップされるようにしているのでしょうか？
おっしゃるとおりで、○をつけるとどこかにカウントアップされるようにしたいのです。
○をつけるべきカウンタは人の数だけ必要だと考えていますが、まだカウントアップの記述さえできていません。

>ということは、○をつけるとカウントが+1されるので、並べ替えをしなくてはなりませんね。そうすれば範囲内で、
>いつも一番上の人に○をつけてカウントアップ　→　並べ替え　→一番上に○
>となりますね。
わたしには並べ替えという発想がありませんでしたが、一番上の人が○である必要はないんです。

>とにかくカウンタが何の数なのかが、また、どこに記述または格納されているのか
>初めは、全員０で、○を付けるとカウントが＋１されると言うことなんですか？
わたしはカウンタは人の数だけ必要だと思っております。
ただ、上述のとおりカウントアップの記述さえできていません。

やりたことはこうです。
○は、F26～F33などのまとまった単位の中のリーダーを決めています。
F26～F33のなかで○をつけおわったなら、次にF34～F38に新たに○をつけますがその場合、リーダーになった回数の多い人よりは、リーダーになった回数の少ない人に○をつけたいんです。
拙い説明ですがご理解をいただけますでしょうか。


	【26461】Re:○の数を平準化するには

ponpon - 05/7/6(水) 0:23 -


	引用なし

	パスワード

こんばんは。

シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
　　With Target
　　　　If .Count > 1 Then Exit Sub
　　　　If IsEmpty(.Value) Then Exit Sub
　　　　If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
　　　　　 If .Value = "○" Then
　　　　　　 Application.EnableEvents = False
　　　　　　 .Offset(0, 4).Value = .Offset(0, 4).Value + 1
　　　　　　 Application.EnableEvents = True
　　　　　 End If
　　　　End If
　　 End With
　　　　　　
End Sub

とすれば、もしE列に○をつけるとI列にカウントアップされます。
以下のSub test2()と組み合わせると自動的にカウントアップされ、
カウントの一番少ない人の中で一番上の行の人に○がつきます。

標準モジュールに
Sub test2()
　　Dim myMin As Integer
　　Dim myRow As Long

　　Range("E:E").ClearContents
　　　　
　　'F26からF33の中でカウントの最も少ない一番上の行の人に"○"をつける。
　　myMin = Application.Min(Cells(26, "I").Resize(8, 1))
　　myRow = Application.Match(myMin, Cells(26, "I").Resize(8, 1), 0)
　　Range("E" & myRow + 26 - 1).Value = "○"
　　
　　
　　'F34から５人ずつの中でカウントの最も少ない一番上の行の人に"○"をつける。
　　For i = 34 To 531 Step 5
　　　　myMin = Application.Min(Cells(i, "I").Resize(5, 1))
　　　　myRow = Application.Match(myMin, Cells(i, "I").Resize(5, 1), 0)
　　　　Range("E" & myRow + i - 1).Value = "○"
　　Next
End Sub

ただし、Match関数は空欄では、エラーを起こすので、一番はじめに一回だけ
I列に"0"を入れていてください。

それから、
>まず、無条件に4箇所(E3,E11,E16,E21)に○をつけます
の人は、F26以降には出てこないのですか？

もし出てくるのなら上記コードはすべてボツです。
F列を検索して、E3,E11,E16,E21と同じ名前の人のカウンタを＋１するコードをを追加しなければなりません。これは、前に回答した中にあったと思います。
E3,E11,E16,E21の値を配列に入れ、F列をFor Eachで検索して、一致したら、Offset(0,3)の値を+1すればよいと思います。

4箇所(E3,E11,E16,E21)の人とF26以降の人との関係が分かりません。

もう一度、シートの詳しいレイアウトを提示して、上級者の方に別途再質問された方が
よいかもしれません。
私のようなものが最初に答えたばっかりに申し訳ありません。


	【26467】Re:○の数を平準化するには

にしもり - 05/7/6(水) 10:10 -


	引用なし

	パスワード

▼ponpon さん：

>私のようなものが最初に答えたばっかりに

とんでもございません。
これ以上お聞きすると「おんぶにだっこ」になってしまいますので以後は自力でやってみます。
本当にありがとうございました。

以前投稿したときに、プログラムを作るときは規則性が大事であることを勉強させていただきました。
今回、取りかかる前に仕様をきちんとかかないといけない事を勉強させていただきました。
お手数をとらせました。
深謝いたします。


	【26475】Re:○の数を平準化するには

小僧 - 05/7/6(水) 13:52 -


	引用なし

	パスワード

▼にしもりさん、ponpon さん：
こんにちは。

>これ以上お聞きすると「おんぶにだっこ」になってしまいますので
>以後は自力でやってみます。

とのスレッドに書き込むのをお許し下さい。
参考程度にでも使ってやって下さい。

F列に既に名前が入っている事と、2行目に表題がついている事が前提です。

Sub 平準化()
Dim I As Long　
Dim J As Long　
Dim K As Long　　　
Dim MyRange As Range
　　
　　ActiveSheet.Range("Z2").Value = "回数"
　　ActiveSheet.Range("Z3:Z531").Value = 0
　　
　　For I = 3 To 531
　　　　Select Case I Mod 23
　　　　　　Case 3
　　　　　　　　J = I + 7
　　　　　　Case 11, 16, 21
　　　　　　　　J = I + 4
　　　　End Select

　　Set MyRange = ActiveSheet.Range("Z" & I & ":Z" & J)
　　　　For K = 1 To MyRange.Count
　　　　　　If MyRange(K) = WorksheetFunction.Min(MyRange.Value) Then
　　　　　　　　MyRange(K).Offset(0, -21).Value = "○"
　　　　　　　　Call カウントアップ(MyRange(K))
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　　　I = J
　　Next
　　Set MyRange = Nothing
End Sub

Sub カウントアップ(MyRange As Range)
Dim R As Range
　　ActiveSheet.Range("F2:F531").AutoFilter _
　　Field:=1, Criteria1:=MyRange.Offset(0, -20).Value
　　
　　Set R = Range("Z2", "Z" & Range("Z65535").End(xlUp).Row)
　　　　R.Value = R(2).Value + 1
　　Set R = Nothing　　
　　ActiveSheet.AutoFilterMode = False
End Sub

Z列を作業列としてカウント数を表示してありますが、
動作が確認できましたら消して下さい。

お邪魔しました。


	【26526】Re:○の数を平準化するには

にしもり - 05/7/7(木) 20:28 -


	引用なし

	パスワード

▼小僧さん：

昨晩、どうカウンターを設けようかと考えましたが自力では無理とおもいました。
今日思いがけず小僧さんからアドバイスをいただき、実行したところ、
多少結果を手修正する必要はあるものの、ほぼ思いどおりの結果が得られました。

小僧さん、ponponさん、本当にありがとうございました。
今後は仕様をきちんとしてからとりかかりたいと存じます。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

9593 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free