Sub sort1()
Dim cSaigo As Long
cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
Worksheets("main").Sort.SortFields.Clear
Worksheets("main").Sort.SortFields.Add Key:=Worksheets("main").Range("B2:B" & cSaigo), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'ワークシートを指定しました
With Worksheets("main").Sort
.SetRange Range("A1:G" & cSaigo)
.Header = xlYes
.Apply
End With
Worksheets("main").Range("A1").Value = "No."
Worksheets("main").Range("A2").Value = 1
Worksheets("main").Range("A2").AutoFill Destination:=Worksheets("main").Range("A2:A" & cSaigo), Type:=xlLinearTrend 'ワークシートを指定しました
End Sub
Sub sort2()
Dim cSaigo As Long
cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
Worksheets("main").Sort.SortFields.Clear
Worksheets("main").Sort.SortFields.Add Key:=Worksheets("main").Range("A2:A" & cSaigo), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'ワークシートを指定しました
With Worksheets("main").Sort
.SetRange Range("A1:G" & cSaigo)
.Header = xlYes
.Apply
End With
End Sub
Sub syokyo()
Dim ws As Worksheet
For Each ws In Worksheets
Application.DisplayAlerts = False
If Left(ws.Name, 4) <> "main" Then 'Left関数を用いました!
ws.Delete
End If
Application.DisplayAlerts = True
Next
End Sub
Sub hontai()
syokyo
Dim cGyo As Long
Dim cSaigo As Long
Dim wsMain As Worksheet
Dim wsNow As Worksheet
Dim sGyosya As String
Dim dDate As Date
Dim cSaki As Long
Set wsMain = Worksheets("main")
cSaigo = wsMain.Range("B" & Rows.Count).End(xlUp).Row
For cGyo = 2 To cSaigo
If sGyosya <> wsMain.Range("B" & cGyo).Value Then
If cGyo > 2 Then
keisen2
End If
Sheets("main1").Copy After:=Sheets(Worksheets.Count)
Sheets("main1 (2)").Name = wsMain.Range("B" & cGyo).Value
Set wsNow = ActiveSheet
sGyosya = wsNow.Name
cSaki = 16
End If
wsNow.Range("F2").Value = wsNow.Name
wsNow.Range("H" & cSaki).Value = wsMain.Range("F" & cGyo).Value
wsNow.Range("F" & cSaki).Value = wsMain.Range("E" & cGyo).Value
wsNow.Range("E" & cSaki).Value = wsMain.Range("D" & cGyo).Value
dDate = wsMain.Range("C" & cGyo).Value
wsNow.Range("B" & cSaki).Value = Format(dDate, "yy")
wsNow.Range("C" & cSaki).Value = Format(dDate, "mm")
wsNow.Range("D" & cSaki).Value = Format(dDate, "dd")
If wsMain.Range("G" & cGyo) > 0 Then
wsNow.Range("I" & cSaki).Value = wsMain.Range("G" & cGyo).Value
ElseIf wsMain.Range("G" & cGyo) < 0 Then
wsNow.Range("J" & cSaki).Value = wsMain.Range("G" & cGyo).Value
End If
If cSaki = 16 Then
wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value
Else
wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value + wsNow.Range("K" & cSaki - 1)
End If
cSaki = cSaki + 1
Next
keisen2
End Sub
Sub keisen2() 'ネットで調べ、シンプルにしました。同じ動作にはなっております。
Dim cSaigo As Long
Dim wsNow As Worksheet
Set wsNow = ActiveSheet
cSaigo = wsNow.Range("B" & Rows.Count).End(xlUp).Row
wsNow.Range("B16:K" & cSaigo).Borders.LineStyle = xlContinuous
End Sub
2018/10/04 13:53
小川慶一さんのコメント
(コメントID: 5757)
わかやまさん:
その後投稿いただいた第13回のメールセミナーへのフィードバック同様、特に問題ありません。
手直しするだけでなく、イチから書き直されることをおすすめします。
> 小川様 > > 再度、手直しいたしました。添削、どうぞよろしくお願いします。 > >
Sub ikkini()
> sort1
> hontai
> sort2
> End Sub
> >
Sub sort1()
> Dim cSaigo As Long
> cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
> Worksheets("main").Sort.SortFields.Clear
> Worksheets("main").Sort.SortFields.Add Key:=Worksheets("main").Range("B2:B" & cSaigo), _
> SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'ワークシートを指定しました
> With Worksheets("main").Sort
> .SetRange Range("A1:G" & cSaigo)
> .Header = xlYes
> .Apply
> End With
> Worksheets("main").Range("A1").Value = "No."
> Worksheets("main").Range("A2").Value = 1
> Worksheets("main").Range("A2").AutoFill Destination:=Worksheets("main").Range("A2:A" & cSaigo), Type:=xlLinearTrend 'ワークシートを指定しました
> End Sub
> >
Sub sort2()
> Dim cSaigo As Long
> cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
> Worksheets("main").Sort.SortFields.Clear
> Worksheets("main").Sort.SortFields.Add Key:=Worksheets("main").Range("A2:A" & cSaigo), _
> SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'ワークシートを指定しました
> With Worksheets("main").Sort
> .SetRange Range("A1:G" & cSaigo)
> .Header = xlYes
> .Apply
> End With
> End Sub
> >
Sub syokyo()
> Dim ws As Worksheet
> For Each ws In Worksheets
> Application.DisplayAlerts = False
> If Left(ws.Name, 4) <> "main" Then 'Left関数を用いました!
> ws.Delete
> End If
> Application.DisplayAlerts = True
> Next
> End Sub
> >
Sub hontai()
> syokyo
> Dim cGyo As Long
> Dim cSaigo As Long
> Dim wsMain As Worksheet
> Dim wsNow As Worksheet
> Dim sGyosya As String
> Dim dDate As Date
> Dim cSaki As Long
> Set wsMain = Worksheets("main")
> cSaigo = wsMain.Range("B" & Rows.Count).End(xlUp).Row
> For cGyo = 2 To cSaigo
> If sGyosya <> wsMain.Range("B" & cGyo).Value Then
> If cGyo > 2 Then
> keisen2
> End If
> Sheets("main1").Copy After:=Sheets(Worksheets.Count)
> Sheets("main1 (2)").Name = wsMain.Range("B" & cGyo).Value
> Set wsNow = ActiveSheet
> sGyosya = wsNow.Name
> cSaki = 16
> End If
> wsNow.Range("F2").Value = wsNow.Name
> wsNow.Range("H" & cSaki).Value = wsMain.Range("F" & cGyo).Value
> wsNow.Range("F" & cSaki).Value = wsMain.Range("E" & cGyo).Value
> wsNow.Range("E" & cSaki).Value = wsMain.Range("D" & cGyo).Value
> dDate = wsMain.Range("C" & cGyo).Value
> wsNow.Range("B" & cSaki).Value = Format(dDate, "yy")
> wsNow.Range("C" & cSaki).Value = Format(dDate, "mm")
> wsNow.Range("D" & cSaki).Value = Format(dDate, "dd")
> If wsMain.Range("G" & cGyo) > 0 Then
> wsNow.Range("I" & cSaki).Value = wsMain.Range("G" & cGyo).Value
> ElseIf wsMain.Range("G" & cGyo) < 0 Then
> wsNow.Range("J" & cSaki).Value = wsMain.Range("G" & cGyo).Value
> End If
> If cSaki = 16 Then
> wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value
> Else
> wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value + wsNow.Range("K" & cSaki - 1)
> End If
> cSaki = cSaki + 1
> Next
> keisen2
> End Sub
> >
Sub keisen2() 'ネットで調べ、シンプルにしました。同じ動作にはなっております。
> Dim cSaigo As Long
> Dim wsNow As Worksheet
> Set wsNow = ActiveSheet
> cSaigo = wsNow.Range("B" & Rows.Count).End(xlUp).Row
> wsNow.Range("B16:K" & cSaigo).Borders.LineStyle = xlContinuous
> End Sub
わかやまさんの投稿
(投稿ID: 4198)
再度、手直しいたしました。添削、どうぞよろしくお願いします。
小川慶一さんのコメント
(コメントID: 5757)
その後投稿いただいた第13回のメールセミナーへのフィードバック同様、特に問題ありません。
手直しするだけでなく、イチから書き直されることをおすすめします。
> 小川様
>
> 再度、手直しいたしました。添削、どうぞよろしくお願いします。
>
>
>
>
>
>
>
>
>
>
>
>
>
わかやまさんのコメント
(コメントID: 5761)
ありがとうございます。
同じようなコードを用いて、仕事で実践しています。
よりよいものができるように工夫していきます。
小川慶一さんのコメント
(コメントID: 5765)
この問題で紹介しているパターンは、使いこなせるようになると、実務での応用範囲が広いです。
> 小川様
>
> ありがとうございます。
> 同じようなコードを用いて、仕事で実践しています。
> よりよいものができるように工夫していきます。
>