|
「間取わけ」の元"Sheet1"と成っていた所を引数として外に出し
実行する場合、以下の様に別のプロシージャ(例、「Sub Main_1」、「Sub Main_2」)から
引数とし変更したいシート名を与えて呼び出します
尚、元のコードが自動記録そのままの様なコードなので
多分こうなるのではないかと言う推測で直して居ますので
実際に同じ様に動くのかは、確信の無い所です
Option Explicit
Public Sub Main_1()
'「間取わけ」プロシージャにシート名を引数として与え
'呼び出す
間取わけ "Sheet1"
End Sub
Public Sub Main_2()
'「間取わけ」プロシージャにシート名を引数として与え
'呼び出す
間取わけ "Sheet2"
End Sub
Private Sub 間取わけ(strSheetname As String)
With Sheets(strSheetname).Range("A1")
.AutoFilter Field:=9, Criteria1:="ワンルーム"
.CurrentRegion.Copy Destination:=Sheets("ワンルーム").Range("A1")
Application.Intersect(.CurrentRegion, .CurrentRegion.Offset(1)).EntireRow.Delete
' .AutoFilter
'
.AutoFilter Field:=8, Criteria1:="1"
.CurrentRegion.Copy Destination:=Sheets("1部屋").Range("A1")
Application.Intersect(.CurrentRegion, .CurrentRegion.Offset(1)).EntireRow.Delete
' .AutoFilter
'
.AutoFilter Field:=8, Criteria1:="2"
.CurrentRegion.Copy Destination:=Sheets("2部屋").Range("A1")
Application.Intersect(.CurrentRegion, .CurrentRegion.Offset(1)).EntireRow.Delete
' .AutoFilter
'
.AutoFilter Field:=8, Criteria1:="3"
.CurrentRegion.Copy Destination:=Sheets("3部屋").Range("A1")
Application.Intersect(.CurrentRegion, .CurrentRegion.Offset(1)).EntireRow.Delete
.AutoFilter
'
.CurrentRegion.Copy Destination:=Sheets("4部屋").Range("A1")
.CurrentRegion.EntireRow.Delete
End With
With Sheets("4部屋")
.Cells.Sort _
Key1:=.Range("V1"), Order1:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin, _
DataOption1:=xlSortNormal
End With
With Sheets("3部屋")
.Range("A1").CurrentRegion.Sort _
Key1:=.Range("A2"), Order1:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin, _
DataOption1:=xlSortNormal
End With
With Sheets("2部屋")
.Range("A1").CurrentRegion.Sort _
Key1:=.Range("A2"), Order1:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin, _
DataOption1:=xlSortNormal
End With
With Sheets("1部屋")
.Range("A1").CurrentRegion.Sort _
Key1:=.Range("A2"), Order1:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin, _
DataOption1:=xlSortNormal
End With
With Sheets("1部屋")
With .Range("A1")
.AutoFilter Field:=9, Criteria1:="1LDK"
.CurrentRegion.Copy Destination:=Sheets("1LDK").Range("A1")
Application.Intersect(.CurrentRegion, .CurrentRegion.Offset(1)).EntireRow.Delete
.AutoFilter
End With
.Cells.Sort _
Key1:=.Range("V1"), Order1:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin, _
DataOption1:=xlSortNormal
End With
With Sheets("1LDK")
.Range("A1").CurrentRegion.Sort _
Key1:=.Range("A2"), Order1:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin, _
DataOption1:=xlSortNormal
End With
With Sheets("ワンルーム")
With .Range("A1").CurrentRegion
.Sort _
Key1:=.Range("V2"), Order1:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin, _
DataOption1:=xlSortNormal
.Copy Destination:=Sheets("????").Range("A1")
End With
End With
End Sub
|
|