Option Explicit
'全体に、とてもよく書けています! v(^^*
'変数名で英単語一語のものを使うのは(VBの予約語とかぶるかもしれないので)やや危険。
'dim no as long は、僕なら、他の名称にするかもしれません。
Sub narabikae_1()
Dim ws As Worksheet
Dim no As Long
Dim lastRow As Long
Set ws = Worksheets("main")
lastRow = ws.Range("B65536").End(xlUp).Row
'↓autofillを使うことも試してみてください
For no = 2 To lastRow
ws.Range("A" & no).Value = no - 1
Next
ws.Range("A1").Value = "NO" '←インデント不正
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=Range("B2:B" & lastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws.Sort
.SetRange Range("A1:G317")
.Header = xlYes
.Apply
End With
End Sub
Sub narabikae_2()
Dim ws As Worksheet
Dim no As Long
Dim lastRow As Long
Set ws = Worksheets("main")
lastRow = ws.Range("B65536").End(xlUp).Row
' For no = 2 To lastRow
' ws.Range("A" & no).Value = no - 1
' Next
' ws.Range("A1").Value = "NO"
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=Range("A2:A" & lastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws.Sort
.SetRange Range("A1:G" & lastRow)
.Header = xlYes
.Apply
End With
End Sub
Sub denpyofukusei()
Dim ws As Worksheet
For Each ws In Worksheets
If Left(ws.Name, "main") <> 4 Then
'↓インデント過剰
Sheets("main1").Copy After:=Sheets(2)
Sheets("main1 (2)").Name = Worksheets("main").Range("B2").Value
End If
Next
End Sub
Sub denpyosakusei()
DeleteSheets
narabikae_1 '←より可読性の高い名前にしましょう。具体的に何をするのでしょうか?
Dim shFm As Worksheet
Dim meishou As String
Dim cGyo As Long
Dim lastRow As Long
Dim shTo As Worksheet
Dim saki As Long
Dim dt As Date
Set shFm = Worksheets("main")
lastRow = shFm.Range("B65536").End(xlUp).Row
For cGyo = 2 To lastRow
If meishou <> shFm.Range("B" & cGyo).Value Then
If cGyo > 2 Then
keisen
End If
meishou = shFm.Range("B" & cGyo).Value
Sheets("main1").Copy After:=Sheets(2)
Set shTo = ActiveSheet
shTo.Name = meishou
saki = 16
End If
shTo.Range("H" & saki).Value = shFm.Range("F" & cGyo).Value
shTo.Range("F" & saki).Value = shFm.Range("E" & cGyo).Value
shTo.Range("E" & saki).Value = shFm.Range("D" & cGyo).Value
If shFm.Range("G" & cGyo).Value > 0 Then
shTo.Range("I" & saki).Value = shFm.Range("G" & cGyo).Value
Else
shTo.Range("J" & saki).Value = shFm.Range("G" & cGyo).Value
End If
' keisen
dt = shFm.Range("C" & cGyo).Value
'↓format関数を使うことも試してみてください
shTo.Range("B" & saki).Value = Right(Year(dt), 2)
shTo.Range("C" & saki).Value = Month(dt)
shTo.Range("D" & saki).Value = Day(dt)
shTo.Range("K" & saki).Value = shTo.Range("K" & saki - 1).Value + shTo.Range("I" & saki).Value + shTo.Range("J" & saki).Value
saki = saki + 1
Next
keisen
shFm.Activate
narabikae_2 '←より可読性の高い名前にしましょう。具体的に何をするのでしょうか?
End Sub
Sub DeleteSheets()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In Worksheets
If Left(sh.Name, 4) <> "main" Then
sh.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Sub keisen()
Dim lastRow As Long
lastRow = Range("B65536").End(xlUp).Row
'↓select, selection という言葉がなくなるまでブラッシュアップを!
Range("B16:K" & lastRow + 1).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
受講生さんの投稿
(投稿ID: 4151) 添付ファイルのダウンロード権限がありません
なんとか作成出来ましたが、まだまだ時間がかかっております。でも、自分でも出来ることがわかったので、大変満足しております。作成したファイルを送らせていただきます。お手数ですが、よろしくお願いいたします。
小川慶一さんのコメント
(コメントID: 5706)
おはようございます。
> でも、自分でも出来ることがわかったので、大変満足しております。
こういう課題をやりとげると、自己効力感高まりますよね v(^^*
添削を返送します☆
> いつもお世話になっております。
> なんとか作成出来ましたが、まだまだ時間がかかっております。でも、自分でも出来ることがわかったので、大変満足しております。作成したファイルを送らせていただきます。お手数ですが、よろしくお願いいたします。