作業によってはMacro展開が出来ない場合があります。
例えば、この例のように、日次の予定表(個人別、時間別で業務が記載)から
日毎に業務別で集計表作るなどは、手作業でも相当に厄介です。
この処理はVBAで、構文を書かねばなりません。
1-31日までの日次予定は日毎に1Sheetを使用しています。
業務は記号化されていますが、先頭の文字だけが識別対象です。
For Next 構文を3組入れ子で、まず全体を構築
一番外は 1-31でSheetのセレクト
真ん中は時間帯の読み込み(列)
内側は、業務の個人別枠の読み込み(行)
時間帯によって、業務の位置が異なるので、時間帯毎に読み込み
空欄(NULL)で無ければ、Case文で、識別し、該当の変数をインクリメント
します。
集計して変数は、月計表をセレクトし、日毎の行に書き込みます。
手作業では気が狂いますが、VBAなら1分で完了です。
-----------------------------------------------------------------------------------------
Sub Work_Type_2()
'
' Macro6 Macro
'
Dim A_w, B_w, C_w, D_w, E_w, F_w, G_w, H_w As String
Dim I_w, J_w, K_w, L_w, X_w, Z_w, WM, S_Nm As String
Dim k, f, j As Integer
Dim D_N As Integer
' 変数の宣言は必ず行うこと
' 初期化
A_w = 0
B_w = 0
C_w = 0
D_w = 0
E_w = 0
F_w = 0
G_w = 0
H_w = 0
I_w = 0
J_w = 0
K_w = 0
L_w = 0
X_w = 0
Z_w = 0
'------------------------------------------
For j = 1 To 31 ' 最初のloop 31のSheet用
S_Nm = CStr(j) ' 変数 J を文字変更、記号無しで
Sheets(S_Nm).Select ' ここでセレクト
For f = 4 To 42
For k = 4 To 32
WM = Cells(f, k).Text ' 対象セルの値をGET
WM = Left(WM, 1)
If WM <> "" Then
Select Case WM
Case "A"
A_w = A_w + 1
Case "B"
B_w = B_w + 1
Case "C"
C_w = C_w + 1
Case "D"
D_w = D_w + 1
Case "E"
E_w = E_w + 1
Case "F"
F_w = F_w + 1
Case "G"
G_w = G_w + 1
Case "H"
H_w = H_w + 1
Case "I"
I_w = I_w + 1
Case "J"
J_w = J_w + 1
Case "K"
K_w = K_w + 1
Case "L"
L_w = L_w + 1
Case "X"
X_w = X_w + 1
Case Else
Z_w = Z_w + 1
End Select
End If
k = k + 1 ' 業務内容項目は1セル飛びのため
Next k
Next f
'-------------------------
Sheets("Month-WM").Select
'日付位置 以下はデータの書き込み
D_N = j + 2
Cells(D_N, 3).Value = A_w
Cells(D_N, 4).Value = B_w
Cells(D_N, 5).Value = C_w
Cells(D_N, 6).Value = D_w
Cells(D_N, 7).Value = E_w
Cells(D_N, 8).Value = F_w
Cells(D_N, 9).Value = G_w
Cells(D_N, 10).Value = H_w
Cells(D_N, 11).Value = I_w
Cells(D_N, 12).Value = J_w
Cells(D_N, 13).Value = K_w
Cells(D_N, 14).Value = L_w
Cells(D_N, 15).Value = X_w
Cells(D_N, 16).Value = Z_w
' 変数を使ってのセルへの書き込みは、RANGEよりCELLのほうがやりやすい
A_w = 0
B_w = 0
C_w = 0
D_w = 0
E_w = 0
F_w = 0
G_w = 0
H_w = 0
I_w = 0
J_w = 0
K_w = 0
L_w = 0
X_w = 0
Z_w = 0
Next j
End Sub
-----------------------------------------------------------------------------------------------------
わかお かずまさ
VegaSystems
📷📷📷📷📷📷
#LAN_PRO
#Bloguru
If you are a bloguru member, please login.
Login
If you are not a bloguru member, you may request a free account here:
Request Account