Sub denpyosakusei()
Worksheetsdelete
Dim shFm As Worksheet
Set shFm = Worksheets("main")
Dim cFm
Dim shName
Dim shTo As Worksheet
Dim cTo
For cFm = 2 To shFm.Range("B65536").End(xlUp).Row
shFm.Range("A" & cFm).Value = cFm - 1
Next
shFm.Range("A1").Value = "通番"
With shFm
.Range("A1").Sort key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes
End With
For cFm = 2 To shFm.Range("B65536").End(xlUp).Row
If shFm.Range("B" & cFm).Value <> shFm.Range("B" & cFm - 1).Value Then
cTo = 16
shName = shFm.Range("B" & cFm).Value
Worksheets("main1").Copy After:=ActiveSheet
ActiveSheet.Name = shName
End If
Set shTo = Worksheets(shName)
shTo.Range("E" & cTo).Value = shFm.Range("D" & cFm).Value
shTo.Range("F" & cTo).Value = shFm.Range("E" & cFm).Value
shTo.Range("H" & cTo).Value = shFm.Range("F" & cFm).Value
shTo.Range("B" & cTo).Value = Left(shFm.Range("C" & cFm).Value, 4)
shTo.Range("C" & cTo).Value = Mid(shFm.Range("C" & cFm).Value, InStr(shFm.Range("C" & cFm).Value, "/") + 1, 2)
shTo.Range("D" & cTo).Value = Right(shFm.Range("C" & cFm).Value, 2)
If shFm.Range("G" & cFm).Value < 0 Then
shTo.Range("I" & cTo).Value = 0 - shFm.Range("G" & cFm).Value
Else
shTo.Range("J" & cTo).Value = shFm.Range("G" & cFm).Value
End If
cTo = cTo + 1
shTo.Range("B16" & ":K" & shTo.Range("H65536").End(xlUp).Row).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Next
shFm.AutoFilter.Sort.SortFields.Clear
shFm.AutoFilter.Sort.SortFields.Add2 _
Key:=Range("A1"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("main").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
shFm.Activate
shFm.Range("A2" & ":A" & shFm.Range("B65536").End(xlUp).Row).ClearContents
End Sub
Sub Worksheetsdelete()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In Worksheets
If Left(sh.Name, 4) <> "main" Then
sh.Delete
End If
Next
End Sub
加藤さんの投稿
(投稿ID: 5006)
添削よろしくお願いいたします。
小川慶一さんのコメント
(コメントID: 7147)
こんにちは。
ひととおり、拝見しました。
講座で解説しているやり方と異なるものについては、なぜあえてこういうやり方をしたのか、そして、そのやり方を採用したことのメリット・デメリットは何かということについてコメントをお願いします。
ぱっと見て、たとえば、以下は聞いてみたくなりますね。
[1] 見本と異なり、提出物では、プロシージャを分割せず、その総数を減らしたのはなぜか。
そのメリット・デメリットは?
もしデメリットがあるにも関わらずそうしたならば、なぜ、あえてそうしたのか。
[2] 見本と異なり、提出物では、罫線を引くマクロは、唯一のForNextループ内で、元データからのデータ転記の都度実行されるようになっている。
そのメリット・デメリットは?
もしデメリットがあるにも関わらずそうしたならば、なぜ、あえてそうしたのか。
[3] 見本と異なり、提出物では、罫線をクマクロでは、 Select. Selection という言葉が残っている。
そのメリット・デメリットは?
もしデメリットがあるにも関わらず残したならば、なぜ、あえてそうしたのか。
[4] 並べ替えのマクロは、ForNextループの前にあるものと後にあるものでコーディングスタイルが異なっている。
そのメリット・デメリットは?
もしデメリットがあるにも関わらずそうしたならば、なぜ、あえてそうしたのか。