Option Explicit
Public Moto As Worksheet
Public Saki As Worksheet
Public saigo As Long
Public gyo As Long
Public Tenki As Worksheet
Sub denpyosakusei()
Dim hiduke As Date
Dim kakidasi As Long
Dim kingaku As Long
Dim zandaka As Long
Set Saki = Workbooks("s09_homework").Worksheets("main1")
Set Moto = Workbooks("s09_homework").Worksheets("main")
saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
denpyosyokyo
'作成前のシート"main"の並べ替え
id
hiduke_narabe
b_narabe
'シート作成&転記
For gyo = 2 To saigo
If Moto.Range("B" & gyo).Value <> Moto.Range("B" & gyo - 1).Value Then
kakidasi = 16
zandaka = 0
Saki.Copy After:=Sheets(Worksheets.Count)
Set Tenki = ActiveSheet
Tenki.Name = Moto.Range("B" & gyo).Value
End If
hiduke = Moto.Range("C" & gyo).Value
kingaku = Moto.Range("G" & gyo).Value
Tenki.Range("B" & kakidasi).Value = Right(Year(hiduke), 2)
Tenki.Range("C" & kakidasi).Value = Month(hiduke)
Tenki.Range("D" & kakidasi).Value = Day(hiduke)
Tenki.Range("E" & kakidasi & ":F" & kakidasi).Value = Moto.Range("D" & gyo & ":E" & gyo).Value
Tenki.Range("H" & kakidasi).Value = Moto.Range("F" & gyo).Value
Select Case kingaku
Case Is >= 0
Tenki.Range("I" & kakidasi).Value = kingaku
Case Else
Tenki.Range("J" & kakidasi).Value = kingaku
End Select
zandaka = zandaka + kingaku
Tenki.Range("K" & kakidasi).Value = zandaka
'掛線
If Moto.Range("B" & gyo).Value <> Moto.Range("B" & gyo + 1).Value Then
With Tenki.Range("B16" & ":K" & kakidasi)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
End With
If zandaka < 0 Then '最終残高がマイナスの時、タブの色を赤にするアレンジ
Tenki.Tab.Color = vbRed
End If
End If
kakidasi = kakidasi + 1
Next
Moto.Select 'シート"main"を元に戻す
id_narabe
Moto.Columns("A:A").ClearContents
End Sub
Sub id()
Set Moto = Workbooks("s09_homework").Worksheets("main")
saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
Moto.Range("A1").Value = "No."
For gyo = 2 To saigo
Moto.Range("A" & gyo).Value = gyo - 1
Next
End Sub
Sub b_narabe()
Set Moto = Workbooks("s09_homework").Worksheets("main")
saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
Moto.Sort.SortFields.Clear
Moto.Sort.SortFields.Add Key:=Range("B2:B" & saigo)
With Moto.Sort
.SetRange Range("A1:G" & saigo)
.Header = xlYes
.Apply
End With
End Sub
Sub id_narabe()
Set Moto = Workbooks("s09_homework").Worksheets("main")
saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
Moto.Sort.SortFields.Clear
Moto.Sort.SortFields.Add Key:=Range("A2:A" & saigo)
With Moto.Sort
.SetRange Range("A1:G" & saigo)
.Header = xlYes
.Apply
End With
End Sub
Sub hiduke_narabe()
Set Moto = Workbooks("s09_homework").Worksheets("main")
saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
Moto.Sort.SortFields.Clear
Moto.Sort.SortFields.Add Key:=Range("C2:C" & saigo)
With Moto.Sort
.SetRange Range("A1:G" & saigo)
.Header = xlYes
.Apply
End With
End Sub
Sub denpyosyokyo()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If InStr(ws.Name, "main") = 0 Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
2020/11/22 20:02
小川 慶一さんのコメント
(コメントID: 6947)
らりおさん:
こんにちは。
添削を返送します。
ひきつづき、よい学びを!
Option Explicit
Public Moto As Worksheet
Public Saki As Worksheet
Public saigo As Long
Public gyo As Long
Public Tenki As Worksheet
Sub denpyosakusei()
Dim hiduke As Date
Dim kakidasi As Long
Dim kingaku As Long
Dim zandaka As Long
Set Saki = Workbooks("s09_homework").Worksheets("main1")
Set Moto = Workbooks("s09_homework").Worksheets("main")
saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
denpyosyokyo
'作成前のシート"main"の並べ替え
id
hiduke_narabe
b_narabe
'シート作成&転記
For gyo = 2 To saigo
If Moto.Range("B" & gyo).Value <> Moto.Range("B" & gyo - 1).Value Then
kakidasi = 16
zandaka = 0
Saki.Copy After:=Sheets(Worksheets.Count)
Set Tenki = ActiveSheet
Tenki.Name = Moto.Range("B" & gyo).Value
End If
hiduke = Moto.Range("C" & gyo).Value
kingaku = Moto.Range("G" & gyo).Value
Tenki.Range("B" & kakidasi).Value = Right(Year(hiduke), 2)
Tenki.Range("C" & kakidasi).Value = Month(hiduke)
Tenki.Range("D" & kakidasi).Value = Day(hiduke)
Tenki.Range("E" & kakidasi & ":F" & kakidasi).Value = Moto.Range("D" & gyo & ":E" & gyo).Value
Tenki.Range("H" & kakidasi).Value = Moto.Range("F" & gyo).Value
Select Case kingaku
Case Is >= 0
Tenki.Range("I" & kakidasi).Value = kingaku
Case Else
Tenki.Range("J" & kakidasi).Value = kingaku
End Select
zandaka = zandaka + kingaku
Tenki.Range("K" & kakidasi).Value = zandaka
'掛線
If Moto.Range("B" & gyo).Value <> Moto.Range("B" & gyo + 1).Value Then
With Tenki.Range("B16" & ":K" & kakidasi)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
End With
If zandaka < 0 Then '最終残高がマイナスの時、タブの色を赤にするアレンジ
Tenki.Tab.Color = vbRed
End If
End If
kakidasi = kakidasi + 1
Next
Moto.Select 'シート"main"を元に戻す
id_narabe
Moto.Columns("A:A").ClearContents
End Sub
Sub id()
Set Moto = Workbooks("s09_homework").Worksheets("main")
saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
Moto.Range("A1").Value = "No."
For gyo = 2 To saigo
Moto.Range("A" & gyo).Value = gyo - 1
Next
End Sub
Sub b_narabe()
Set Moto = Workbooks("s09_homework").Worksheets("main")
saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
Moto.Sort.SortFields.Clear
Moto.Sort.SortFields.Add Key:=Range("B2:B" & saigo)
With Moto.Sort
.SetRange Range("A1:G" & saigo)
.Header = xlYes
.Apply
End With
End Sub
Sub id_narabe()
Set Moto = Workbooks("s09_homework").Worksheets("main")
saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
Moto.Sort.SortFields.Clear
Moto.Sort.SortFields.Add Key:=Range("A2:A" & saigo)
With Moto.Sort
.SetRange Range("A1:G" & saigo)
.Header = xlYes
.Apply
End With
End Sub
Sub hiduke_narabe()
Set Moto = Workbooks("s09_homework").Worksheets("main")
saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
Moto.Sort.SortFields.Clear
Moto.Sort.SortFields.Add Key:=Range("C2:C" & saigo)
With Moto.Sort
.SetRange Range("A1:G" & saigo)
.Header = xlYes
.Apply
End With
End Sub
Sub denpyosyokyo()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If InStr(ws.Name, "main") = 0 Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
らりおさんの投稿
(投稿ID: 4930)
添削宜しくお願い致します。
小川 慶一さんのコメント
(コメントID: 6947)
こんにちは。
添削を返送します。
ひきつづき、よい学びを!