Option Explicit
Sub CreateDenpyo()
DeleteSheets
CreateDenpyoExe
End Sub
Sub DeleteSheets()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If Left(ws.Name, 4) <> "main" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Sub CreateDenpyoExe()
'連想配列を使って、伝票作成のコードを書きました。
Dim dic As New Scripting.Dictionary 'index=取引先名称、Item=転記先シートでの行数とする連想配列。
Dim c As Long 'Worksheets("main")の行数カウンター
Dim cMx As Long 'Worksheets("main")の最終行数
Dim dt As Long 'Worksheets("main")C列の日付
Dim st As String 'Worksheets("main")B列の取引先名称
Dim w As Worksheet 'Worksheets("main")のニックネーム
Set w = Worksheets("main")
cMx = w.Range("a65536").End(xlUp).Row
For c = 2 To cMx
st = w.Range("B" & c).Value
If dic.Exists(st) = True Then
dic.Item(st) = dic.Item(st) + 1
Else
dic.Add st, 16
CreateSheets st
End If
InputData st, c, dic.Item(st)
Next
Dim vkey As Variant
vkey = dic.Keys
For c = LBound(vkey) To UBound(vkey)
If Left(vkey(c), 4) <> "main" Then
Keisen vkey(c), dic.Item(vkey(c))
End If
Next
w.Select
Range("a1").Select
End Sub
Sub CreateSheets(st As String)
Worksheets("main1").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = st
End Sub
Sub InputData(st As String, cFm As Long, cTo As Long)
Dim dt As Date
Dim wTo As Worksheet
Dim wFm As Worksheet
Dim cKingaku
Set wTo = Worksheets(st)
Set wFm = Worksheets("main")
dt = wFm.Range("c" & cFm).Value
wTo.Range("b" & cTo).Value = Right(Year(dt), 2)
wTo.Range("c" & cTo).Value = Month(dt)
wTo.Range("d" & cTo).Value = Day(dt)
wTo.Range("e" & cTo).Value = wFm.Range("d" & cFm).Value
wTo.Range("f" & cTo).Value = wFm.Range("e" & cFm).Value
wTo.Range("h" & cTo).Value = wFm.Range("f" & cFm).Value
cKingaku = wFm.Range("g" & cFm).Value
If cKingaku >= 0 Then
wTo.Range("i" & cTo).Value = cKingaku
Else
wTo.Range("j" & cTo).Value = cKingaku
End If
If cTo = 16 Then
wTo.Range("k" & cTo).Value = cKingaku
Else
wTo.Range("k" & cTo).Value = wTo.Range("k" & cTo - 1).Value + cKingaku
End If
End Sub
Sub Keisen(st As Variant, c As Long)
'
' 罫線を引く
Worksheets(st).Select
With Range("B16:K" & c + 1)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
End Sub
受講生さんの投稿
(投稿ID: 3474) 添付ファイルのダウンロード権限がありません
小川慶一さんのコメント
(コメントID: 4943) 添付ファイルのダウンロード権限がありません
添削を返送します。
よく書けていると思いますよ!かなり上達されしましたね☆
> 発展編1のファイル"Enshu21200.xls"の伝票作成の問題で、模範解答でなく、連想配列を使って、コードを書いてみました。動きましたが、採点をしていただければ、嬉しいです。
受講生さんのコメント
(コメントID: 4947)
採点有難うございます。
配列、特に連想配列は最初とっつきにくかったですが、慣れると、形通りにコードを書けてくるので、クセになりますね!
> 受講生 さん:
>
> 添削を返送します。
> よく書けていると思いますよ!かなり上達されしましたね☆
>
> > 発展編1のファイル"Enshu21200.xls"の伝票作成の問題で、模範解答でなく、連想配列を使って、コードを書いてみました。動きましたが、採点をしていただければ、嬉しいです。
>