Excel自動化
仕事を片っ端から自動化しませんか？
それが出来たらどんなにいいか？
そう思うのは私だけではないと思います。
新聞店で働いているあなたも、毎日毎日の配達していて
もっと効率よく働き「自分の自由に使える時間を増やしたい！」
と思ったことは一度や二度ではないと思います。
今回、紹介する動画はExcel VBAを使って
①配達
・本誌、諸紙の定数｜休み（曜日休みも含む）｜
入り（即入も含む）｜止め（即止めも含む）｜試読
②集金
・毎日の配達と連動させ消込業務をボタン一つで解決
③区域の個々の数、全体の総数が自動で求められる。
入力した瞬間、数えることなく数がでます。
この他にも個人的に利用している機能があるのですが
それは、またいつか紹介します。
動画で紹介できなかった、次の月、次の年への自動での移動。
祝日、振替休日の仕組みは機会があったらご紹介いたします。
Sub pro_q()
Dim i As Integer
Set Ws1 = Sheets(“process”)
Set Ws3 = Sheets(“iri_tome”)
For i = 6 To 36 ‘日付の最後の行までループ
Ws1.Range(“Q” & i) = Ws1.Range(“D1”) _
– WorksheetFunction.CountIfs(Ws1.Range(“D6:D36”), “朝”, Ws1.Range(“F6:F36”), “<=” & Ws1.Range(“O” & i)) _
+ WorksheetFunction.CountIfs(Ws1.Range(“D6:D36”), “朝”, Ws1.Range(“H6:H36”), “<” & Ws1.Range(“O” & i)) _
– WorksheetFunction.CountIfs(Ws3.Range(“A4:A34”), “朝”, Ws3.Range(“C4:C34”), “<=” & Ws1.Range(“O” & i)) _
– WorksheetFunction.CountIfs(Ws3.Range(“A4:A34”), “ヨ”, Ws3.Range(“C4:C34”), “<=” & Ws1.Range(“O” & i)) _
+ WorksheetFunction.CountIfs(Ws3.Range(“A4:A34”), “朝”, Ws3.Range(“D4:D34”), “<=” & Ws1.Range(“O” & i)) _
+ WorksheetFunction.CountIfs(Ws3.Range(“A4:A34”), “ヨ”, Ws3.Range(“D4:D34”), “<=” & Ws1.Range(“O” & i)) _
– Ws1.Range(“AP” & i)
‘(本日の朝刊実配数） = (朝刊定数) – (中止期間中数) – (即止数) + (即入数)
Next i
End Sub
Sub pro_r()
Dim i As Integer
Set Ws1 = Sheets(“process”)
Set Ws3 = Sheets(“iri_tome”)
For i = 6 To 36 ‘日付最後の行までループ
Ws1.Range(“R” & i) = Ws1.Range(“D2”) _
– WorksheetFunction.CountIfs(Ws1.Range(“C6:C36”), “夕”, Ws1.Range(“G6:G36”), “<=” & Ws1.Range(“O” & i)) _
+ WorksheetFunction.CountIfs(Ws1.Range(“C6:C36”), “夕”, Ws1.Range(“I6:I36”), “<” & Ws1.Range(“O” & i)) _
– WorksheetFunction.CountIfs(Ws3.Range(“A4:A34”), “ヨ”, Ws3.Range(“C4:C34”), “<=” & Ws1.Range(“O” & i)) _
+ WorksheetFunction.CountIfs(Ws3.Range(“A4:A34”), “ヨ”, Ws3.Range(“D4:D34”), “<=” & Ws1.Range(“O” & i)) _
– Ws1.Range(“AQ” & i)
‘(本日の夕刊実配数) = (夕刊定数) – (夕刊中止数)
Next i
End Sub
Function getDateWeekNum(myYear As Long, myMonth As Long, _
myWeekday As VbDayOfWeek, weekNum As Integer) As Date
Dim firstWeekday As Integer ‘ 指定した年月の1日の曜日番号
Dim Sabun As Integer ‘ 曜日番号の差分
‘ 指定した年月の1日の曜日番号求める
firstWeekday = Weekday(DateSerial(myYear, myMonth, 1))
‘1日の曜日番号と求めたい曜日番号の差分を求める
Sabun = myWeekday – firstWeekday
If myWeekday < firstWeekday Then
Sabun = Sabun + 7
End If
‘ 目的の日付データを求めて返す
getDateWeekNum = Year(DateSerial(myYear, myMonth, 1 + Sabun + 7 * (weekNum – 1))) & “/” & Month(DateSerial(myYear, myMonth, 1 + Sabun + 7 * (weekNum – 1))) & “/” & Day(DateSerial(myYear, myMonth, 1 + Sabun + 7 * (weekNum – 1)))
End Function
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub shori()
pro_c
pro_c2
pro_d
pro_d2
pro_e
pro_e2
pro_f
pro_f2
pro_g
pro_g2
pro_h
pro_h2
pro_i
pro_i2
pro_j
pro_j2
・・・
End Sub
Sub next_month1()
Set Ws1 = Sheets(“process”)
Set Ws2 = Sheets(“take”)
Set Ws4 = Sheets(“process2”)
Set Ws5 = Sheets(“tom2”)
Set Ws8 = Sheets(“balance”)
‘まず『take』シートの年月日表示を更新する
Ws2.Range(“A2”) = Ws1.Range(“B1”) + Int(Ws1.Range(“B2”) / 12)
Ws2.Range(“B2”) = (Ws2.Range(“B2”) Mod 12) + 1
Ws2.Range(“C2”) = 1
If WorksheetFunction.CountIf(Ws1.Range(“W19:W25”), Ws1.Range(“B2”)) = 1 Then
Ws2.Range(“D2”) = 31
ElseIf WorksheetFunction.CountIf(Ws1.Range(“X19:X25”), Ws1.Range(“B2”)) = 1 Then
Ws2.Range(“D2”) = 30
Else: Ws2.Range(“D2”) = 28 + Ws1.Range(“AA19”)
End If
End Sub
Sub next_month2()
Dim i, j As Integer
Set Ws1 = Sheets(“process”)
Set Ws2 = Sheets(“take”)
Set Ws4 = Sheets(“process2”)
Ws1.Range(“O6:U40”) = “”
Ws1.Range(“Y6:Y40”) = “”
Ws4.Range(“O6:S40”) = “”
Ws4.Range(“Y6:Y40”) = “”
‘次に『process』『process』シートのO列に日にち、Y列に『年/月/日』を1日から月末まで入力する
For i = 6 To Ws2.Range(“D2”) + 5
Ws1.Range(“O” & i) = i – 5
Ws1.Range(“Y” & i) = Ws1.Range(“B1”) & “/” & Ws1.Range(“B2”) & “/” & (i – 5)
Ws4.Range(“O” & i) = i – 5
Ws4.Range(“Y” & i) = Ws4.Range(“B1”) & “/” & Ws4.Range(“B2”) & “/” & (i – 5)
Next i
‘P列にはO列の日にちに対する曜日を入力する
For j = 6 To Ws2.Range(“D2”) + 5
Ws1.Range(“P” & j) = WorksheetFunction.Weekday(DateValue(Ws1.Range(“Y” & j)))
Ws4.Range(“P” & j) = WorksheetFunction.Weekday(DateValue(Ws4.Range(“Y” & j)))
Next j
For k = 6 To Ws2.Range(“D2”) + 5
Select Case Ws1.Range(“P” & k).Value
Case 1
Ws1.Range(“P” & k) = “日”
Case 2
Ws1.Range(“P” & k) = “月”
Case 3
Ws1.Range(“P” & k) = “火”
Case 4
Ws1.Range(“P” & k) = “水”
Case 5
Ws1.Range(“P” & k) = “木”
Case 6
Ws1.Range(“P” & k) = “金”
Case 7
Ws1.Range(“P” & k) = “土”
End Select
Next k
End Sub
Dim i As Integer
Set Ws8 = Sheets(“balance”)
Set Ws1 = Sheets(“process”)
Set Ws4 = Sheets(“process2”)
Set Ws9 = Sheets(“back_up”)
back_up
zengetsu_zan
next_month1
next_month2
next_month3
next_month4
holiday
For i = 6 To 20
If Ws8.Range(“A” & i) <> “” Then
Ws8.Range(“J” & i) = Ws8.Range(“B2”) & “*” & _
Ws8.Range(“C” & i) & “*” & _
(Ws8.Range(“F” & i) – Ws9.Range(“D2”))
End If
Next i
Ws1.Range(“B6:B36”) = “”
Ws4.Range(“B6:B36”) = “”
End Sub
|
|
|
|
この記事へのコメントはありません。