Excel VBA質問箱 IV

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

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


55218 / 76732 ←次へ | 前へ→

【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の人に1ポイント追加し、
 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
1 hits

【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 お礼

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