Sub creatDenpyo()
deleteDenpyo
Dim wFm As Worksheet
Set wFm = Worksheets("main")
Dim wTmp As Worksheet
Set wTmp = Worksheets("main1")
Dim wTo As Worksheet
'(1)A列に番号を振る(オートフィルで)
wFm.Range("A2").FormulaR1C1 = "1"
wFm.Range("A3").FormulaR1C1 = "2"
wFm.Range("A2:A3").AutoFill Destination:=wFm.Range("A2:A317")
'(2)B列でソート
wFm.Range("A1:G317").Sort Key1:=wFm.Range("B1"), Order1:=xlAscending, Header:=xlYes
'(3)伝票テンプレートにヘッダー/フッター挿入、印刷範囲設定クリア
With wTmp.PageSetup
.CenterHeader = "&A"
.CenterFooter = "&P / &N ページ"
.PrintArea = ""
End With
'(4)伝票作成
Dim gyo As Long
Dim gyoMax As Long
gyoMax = wFm.Range("B" & Rows.Count).End(xlUp).Row
Dim gyoTo As Long
gyoTo = 16
For gyo = 2 To gyoMax
If wFm.Range("B" & gyo).Value <> wFm.Range("B" & gyo - 1).Value Then
If gyo > 2 Then
keisen
End If
gyoTo = 16
wTmp.Copy After:=Sheets(2)
Set wTo = ActiveSheet
wTo.Name = wFm.Range("B" & gyo).Value
End If
wTo.Range("B" & gyoTo) = Mid(Year(wFm.Range("C" & gyo).Value), 3)
wTo.Range("C" & gyoTo) = Month(wFm.Range("C" & gyo).Value)
wTo.Range("D" & gyoTo) = Day(wFm.Range("C" & gyo).Value)
wTo.Range("E" & gyoTo) = wFm.Range("D" & gyo).Value
wTo.Range("F" & gyoTo) = wFm.Range("E" & gyo).Value
wTo.Range("H" & gyoTo) = wFm.Range("F" & gyo).Value
If wFm.Range("G" & gyo).Value > 0 Then
wTo.Range("I" & gyoTo) = wFm.Range("G" & gyo).Value
Else
wTo.Range("J" & gyoTo) = wFm.Range("G" & gyo).Value
End If
If gyoTo > 16 Then
wTo.Range("K" & gyoTo) = wTo.Range("I" & gyoTo).Value + wTo.Range("J" & gyoTo).Value + wTo.Range("K" & gyoTo - 1).Value
Else
wTo.Range("K" & gyoTo) = wTo.Range("I" & gyoTo).Value + wTo.Range("J" & gyoTo).Value
End If
gyoTo = gyoTo + 1
Next
keisen
'(5)A列でソート
wFm.Range("A1:G317").Sort Key1:=wFm.Range("A1"), Order1:=xlAscending, Header:=xlYes
'(6)A列の値消去
wFm.Range("A1:A317").ClearContents
End Sub
Sub deleteDenpyo()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> "main1" And ws.Name <> "main" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Sub keisen()
Dim gyoMax
gyoMax = Range("B" & Rows.Count).End(xlUp).Row
With Range("B16", "K" & gyoMax)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
End With
End Sub
受講生さんの投稿
(投稿ID: 1927)
追加要件の宿題を提出いたします。前回の宿題提出時に頂いたご指導のお陰で、ループの初回の罫線設定回避策もよく理解出来て、スラスラと書けるようになりました。
今回はオートフィルでA列に番号を振る別解としました。オートフィルのハンドル部分をダブルクリックするだけで、表がある部分全てにオートフィルが実行されることは知らなかったので、
また新たな学びが出来ました。(今更というカンジですが…(;・∀・))添削ご指導よろしくお願いいたします。
ゲストさんのコメント
(コメントID: 3306)
> ループの初回の罫線設定回避策もよく理解出来て、スラスラと書けるようになりました。
よかったです。
なにしろ、ここは、ある意味難所なので。
でも、一度自力でやったからこそ、解説がよく理解できますね。
いただいたマクロ。
いいですね。ほぼほぼカンペキです。
とりわけ、変数 wTmp とかシブいです。
ここまでできれば相当の仕事でもできるはずです ヾ(´ー`)ノ
autofillの準備に2つのデータを投入している箇所は、 .Value でもOKです。
データ数が316件を超えたときに一部不具合が出るので、そこを修正してみてください。
>小川先生、いつもお世話になっております。
>追加要件の宿題を提出いたします。前回の宿題提出時に頂いたご指導のお陰で、ループの初回の罫線設定回避策もよく理解出来て、スラスラと書けるようになりました。
>今回はオートフィルでA列に番号を振る別解としました。オートフィルのハンドル部分をダブルクリックするだけで、表がある部分全てにオートフィルが実行されることは知らなかったので、
>また新たな学びが出来ました。(今更というカンジですが…(;・∀・))添削ご指導よろしくお願いいたします。