Excell-VBA 日計から月計表

ExcelVBAにかぎらず、Macroの記憶をしてくれるのは便利ですが、
作業によっては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
#kuma

People Who Wowed This Post

×
  • 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
This user only allows bloguru members to make comments.
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