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 'ワークシートを指定しました
heda 'ヘッダーとフッターの設定
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
Sub heda()
With Worksheets("main1").PageSetup
.CenterHeader = "伝票"
.CenterFooter = Date
End With
End Sub
2018/10/06 15:40
小川慶一さんのコメント
(コメントID: 5758)
わかやまさん:
Sub heda() の中身、よく調べられましたね。 このコードでも良いのですが、最善策は、「テンプレートのヘッダーフッターを修正する」でした。そのほうが簡単です。
> 小川様 > > 添削よろしくお願いいたします。 > >
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 'ワークシートを指定しました
> heda 'ヘッダーとフッターの設定
> 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
> >
Sub heda()
> With Worksheets("main1").PageSetup
> .CenterHeader = "伝票"
> .CenterFooter = Date
> End With
> End Sub
わかやまさんの投稿
(投稿ID: 4199)
添削よろしくお願いいたします。
小川慶一さんのコメント
(コメントID: 5758)
Sub heda() の中身、よく調べられましたね。
このコードでも良いのですが、最善策は、「テンプレートのヘッダーフッターを修正する」でした。そのほうが簡単です。
> 小川様
>
> 添削よろしくお願いいたします。
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
わかやまさんのコメント
(コメントID: 5763)
添削ありがとうございました。
テンプレートのヘッダーフッターを修正しているつもりなのですが、どの部分がおかしいでしょうか?
どうぞよろしくお願いします。
小川慶一さんのコメント
(コメントID: 5764)
おはようございます。
Sub heda()
With Worksheets("main1").PageSetup
.CenterHeader = "伝票"
.CenterFooter = Date
End With
End Sub[/code]
も不要です。
プログラムで手直しするのではなく、プログラム実行前に、手作業でワークシート「main1」にヘッダーフッターを入れます。
そうすると、このプログラムを書くことも、このプログラムをを書くための調査も不要になります。
> 小川様
>
> 添削ありがとうございました。
> テンプレートのヘッダーフッターを修正しているつもりなのですが、どの部分がおかしいでしょうか?
> どうぞよろしくお願いします。