Sub sort1() Dim kazu As Long Dim saigo As Long Columns("A:G").Select ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear ActiveWorkbook.Worksheets("main").Sort.SortFields.Add Key:=Range("B2:B317"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("main").Sort .SetRange Range("A1:G317") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With
saigo = Worksheets("main").Range("B65536").End(xlUp).Row Worksheets("main").Range("A1").Value = "No." For kazu = 2 To saigo Worksheets("main").Range("A" & kazu).Value = kazu - 1 Next End Sub[/code]
Sub syokyo()
Dim ws As Worksheet
For Each ws In Worksheets
Application.DisplayAlerts = False
If ws.Name = "main" Then
ElseIf ws.Name = "main1" Then
Else
ws.Delete
End If
Application.DisplayAlerts = True
Next
End Sub
Sub hontai()
syokyo
Dim gyo As Long
Dim saigo1 As Long
Dim wsmain As Worksheet
Dim wsnow As Worksheet
Dim gyosya As String
Dim dt As Date
Dim saki As Long
Set wsmain = Worksheets("main")
saigo1 = wsmain.Range("B65536").End(xlUp).Row
For gyo = 2 To saigo1
If gyosya <> wsmain.Range("B" & gyo).Value Then
If gyo > 2 Then
keisen
End If
Sheets("main1").Copy After:=Sheets(2)
Sheets("main1 (2)").Name = wsmain.Range("B" & gyo).Value
Set wsnow = ActiveSheet
gyosya = wsnow.Name
saki = 16
End If
wsnow.Range("F2").Value = wsnow.Name
wsnow.Range("H" & saki).Value = wsmain.Range("F" & gyo).Value
wsnow.Range("F" & saki).Value = wsmain.Range("E" & gyo).Value
wsnow.Range("E" & saki).Value = wsmain.Range("D" & gyo).Value
dt = wsmain.Range("C" & gyo).Value
wsnow.Range("B" & saki).Value = Right(Year(dt), 2)
wsnow.Range("C" & saki).Value = Month(dt)
wsnow.Range("D" & saki).Value = Day(dt)
If wsmain.Range("G" & gyo) > 0 Then
wsnow.Range("I" & saki).Value = wsmain.Range("G" & gyo).Value
ElseIf wsmain.Range("G" & gyo) < 0 Then
wsnow.Range("J" & saki).Value = wsmain.Range("G" & gyo).Value
End If
If saki = 16 Then
wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value
Else
wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value + wsnow.Range("K" & saki - 1)
End If
saki = saki + 1
Next
keisen
End Sub
Sub keisen()
Dim saigo2 As Long
Dim wsnow1 As Worksheet
Set wsnow1 = ActiveSheet
saigo2 = wsnow1.Range("B65536").End(xlUp).Row
Range("B16:K" & saigo2).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
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
End Sub
2018/10/01 15:22
小川慶一さんのコメント
(コメントID: 5747)
わかやまさん:
添削を返送します。
Option Explicit
Sub ikkini()
sort1
hontai
'最後にA列での並べ替えを。
End Sub
Sub sort1()
'select, selectionがなくなるまでリライトしましょう。
'並べ替え部分はデータ数に無関係に動作するようにリライトしましょう。
Dim kazu As Long
Dim saigo As Long
Columns("A:G").Select
ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("main").Sort.SortFields.Add Key:=Range("B2:B317"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("main").Sort
.SetRange Range("A1:G317")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
saigo = Worksheets("main").Range("B65536").End(xlUp).Row '最終行が何行目でも(65536行でも1048576行でも)動くようにリライトしましょう。
Worksheets("main").Range("A1").Value = "No."
For kazu = 2 To saigo
Worksheets("main").Range("A" & kazu).Value = kazu - 1
Next
End Sub
Sub syokyo()
Dim ws As Worksheet
For Each ws In Worksheets
Application.DisplayAlerts = False
'↓elseifなしで表現してください
If ws.Name = "main" Then
ElseIf ws.Name = "main1" Then
Else
ws.Delete
End If
Application.DisplayAlerts = True
Next
End Sub
Sub hontai()
syokyo
Dim gyo As Long
'↓sor1ではsaigo,ここではsaigo1という名前にした理由は?重複を避けたということなら別プロシージャ内の変数なのでその心配は不要です。
Dim saigo1 As Long
'↓ハンガリアン記法なら、大文字小文字のメリハリをつける。発展編1本編第1章を復習のこと。
Dim wsmain As Worksheet
Dim wsnow As Worksheet
Dim gyosya As String
Dim dt As Date
Dim saki As Long
Set wsmain = Worksheets("main")
saigo1 = wsmain.Range("B65536").End(xlUp).Row
'以下はまあまあよく書けています v(^^*
For gyo = 2 To saigo1
If gyosya <> wsmain.Range("B" & gyo).Value Then
If gyo > 2 Then
keisen
End If
Sheets("main1").Copy After:=Sheets(2)
Sheets("main1 (2)").Name = wsmain.Range("B" & gyo).Value
Set wsnow = ActiveSheet
gyosya = wsnow.Name
saki = 16
End If
'インデント不正。ここからNext手前までひとつ多すぎです。
wsnow.Range("F2").Value = wsnow.Name
wsnow.Range("H" & saki).Value = wsmain.Range("F" & gyo).Value
wsnow.Range("F" & saki).Value = wsmain.Range("E" & gyo).Value
wsnow.Range("E" & saki).Value = wsmain.Range("D" & gyo).Value
dt = wsmain.Range("C" & gyo).Value
'↓Format関数を使う方法も研究してください
wsnow.Range("B" & saki).Value = Right(Year(dt), 2)
wsnow.Range("C" & saki).Value = Month(dt)
wsnow.Range("D" & saki).Value = Day(dt)
If wsmain.Range("G" & gyo) > 0 Then
wsnow.Range("I" & saki).Value = wsmain.Range("G" & gyo).Value
ElseIf wsmain.Range("G" & gyo) < 0 Then
wsnow.Range("J" & saki).Value = wsmain.Range("G" & gyo).Value
End If
If saki = 16 Then
wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value
Else
wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value + wsnow.Range("K" & saki - 1)
End If
saki = saki + 1
Next
keisen
End Sub
Sub keisen()
'変数名再考のこと。
'sort1と同様、 select, selectionをなくす。
Dim saigo2 As Long
Dim wsnow1 As Worksheet
Set wsnow1 = ActiveSheet
saigo2 = wsnow1.Range("B65536").End(xlUp).Row
Range("B16:K" & saigo2).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
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
End Sub
> 小川様 > > いつもありがとうございます。添削をお願いいたします。 >
Sub ikkini()
> sort1
> hontai
> End Sub
> > Sub sort1() > Dim kazu As Long > Dim saigo As Long > Columns("A:G").Select > ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear > ActiveWorkbook.Worksheets("main").Sort.SortFields.Add Key:=Range("B2:B317"), _ > SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal > With ActiveWorkbook.Worksheets("main").Sort > .SetRange Range("A1:G317") > .Header = xlYes > .MatchCase = False > .Orientation = xlTopToBottom > .SortMethod = xlPinYin > .Apply > End With > > saigo = Worksheets("main").Range("B65536").End(xlUp).Row > Worksheets("main").Range("A1").Value = "No." > For kazu = 2 To saigo > Worksheets("main").Range("A" & kazu).Value = kazu - 1 > Next > End Sub[/code] > > >
Sub syokyo()
> Dim ws As Worksheet
> For Each ws In Worksheets
> Application.DisplayAlerts = False
> If ws.Name = "main" Then
> ElseIf ws.Name = "main1" Then
> Else
> ws.Delete
> End If
> Application.DisplayAlerts = True
> Next
> End Sub
> >
Sub hontai()
> syokyo
> Dim gyo As Long
> Dim saigo1 As Long
> Dim wsmain As Worksheet
> Dim wsnow As Worksheet
> Dim gyosya As String
> Dim dt As Date
> Dim saki As Long
> Set wsmain = Worksheets("main")
> saigo1 = wsmain.Range("B65536").End(xlUp).Row
> For gyo = 2 To saigo1
> If gyosya <> wsmain.Range("B" & gyo).Value Then
> If gyo > 2 Then
> keisen
> End If
> Sheets("main1").Copy After:=Sheets(2)
> Sheets("main1 (2)").Name = wsmain.Range("B" & gyo).Value
> Set wsnow = ActiveSheet
> gyosya = wsnow.Name
> saki = 16
> End If
> wsnow.Range("F2").Value = wsnow.Name
> wsnow.Range("H" & saki).Value = wsmain.Range("F" & gyo).Value
> wsnow.Range("F" & saki).Value = wsmain.Range("E" & gyo).Value
> wsnow.Range("E" & saki).Value = wsmain.Range("D" & gyo).Value
> dt = wsmain.Range("C" & gyo).Value
> wsnow.Range("B" & saki).Value = Right(Year(dt), 2)
> wsnow.Range("C" & saki).Value = Month(dt)
> wsnow.Range("D" & saki).Value = Day(dt)
> If wsmain.Range("G" & gyo) > 0 Then
> wsnow.Range("I" & saki).Value = wsmain.Range("G" & gyo).Value
> ElseIf wsmain.Range("G" & gyo) < 0 Then
> wsnow.Range("J" & saki).Value = wsmain.Range("G" & gyo).Value
> End If
> If saki = 16 Then
> wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value
> Else
> wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value + wsnow.Range("K" & saki - 1)
> End If
> saki = saki + 1
> Next
> keisen
> End Sub
> >
Sub keisen()
> Dim saigo2 As Long
> Dim wsnow1 As Worksheet
> Set wsnow1 = ActiveSheet
> saigo2 = wsnow1.Range("B65536").End(xlUp).Row
> Range("B16:K" & saigo2).Select
> Selection.Borders(xlDiagonalDown).LineStyle = xlNone
> Selection.Borders(xlDiagonalUp).LineStyle = xlNone
> 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
> End Sub
わかやまさんの投稿
(投稿ID: 4189)
いつもありがとうございます。添削をお願いいたします。
Sub sort1()
Dim kazu As Long
Dim saigo As Long
Columns("A:G").Select
ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("main").Sort.SortFields.Add Key:=Range("B2:B317"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("main").Sort
.SetRange Range("A1:G317")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
saigo = Worksheets("main").Range("B65536").End(xlUp).Row
Worksheets("main").Range("A1").Value = "No."
For kazu = 2 To saigo
Worksheets("main").Range("A" & kazu).Value = kazu - 1
Next
End Sub[/code]
小川慶一さんのコメント
(コメントID: 5747)
添削を返送します。
> 小川様
>
> いつもありがとうございます。添削をお願いいたします。
>
>
> Sub sort1()
> Dim kazu As Long
> Dim saigo As Long
> Columns("A:G").Select
> ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
> ActiveWorkbook.Worksheets("main").Sort.SortFields.Add Key:=Range("B2:B317"), _
> SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
> With ActiveWorkbook.Worksheets("main").Sort
> .SetRange Range("A1:G317")
> .Header = xlYes
> .MatchCase = False
> .Orientation = xlTopToBottom
> .SortMethod = xlPinYin
> .Apply
> End With
>
> saigo = Worksheets("main").Range("B65536").End(xlUp).Row
> Worksheets("main").Range("A1").Value = "No."
> For kazu = 2 To saigo
> Worksheets("main").Range("A" & kazu).Value = kazu - 1
> Next
> End Sub[/code]
>
>
>
>
>
>
>