|
Sub 郵便番号SORT()
dblStart = Timer '開始時刻取得
'以下出力シートをコピー
Application.DisplayAlerts = False 'ダイアログオフ
Sheets("出力 (2)").Delete '出力 (2)シート削除
Application.DisplayAlerts = True 'ダイアログオン
Sheets("出力").Copy Before:=Sheets("Sheet3") '出力シートをSheet3の左側へコピーして出力 (2)シート作成
'以下出力 (2)シートをソート
With ActiveWorkbook.Worksheets("出力").Sort
.SortFields.Clear '以前のソートキーをクリア
.SortFields.Add Key:=Range("G1"), Order:=xlAscending 'ソートキー追加。昇順。降順は、xlDescending。
.SetRange Range("A1:J130000") 'ソートするデータ範囲
.Header = xlYes '先頭がヘッダーxlYes。先頭もデータの場合は、xlGuess。
.Apply 'ソートを実行
End With
'以下出力 (2)シートをソート
Dim x As Long, y As Long, z As Long, i As Long, j As Long, k As Long, yuno As Long
'↑x:入力行 y:入力列 z:郵便番号列 i:テーブル行 j:集計用行番号 yuno:退避郵便番号
Dim tbl(100) As String, maeflg As Long, maegyo As Long
k = 1 'SET文出力先列
z = 7 'SET文出力先列G
x = 2
maeflg = 0
maegyo = 0
yuno = Sheets("出力 (2)").Cells(x, z).Value '2行目の郵便番号を退避
For x = 3 To 130000
If Sheets("出力 (2)").Cells(x, z + 1).Value <> "" Then
If Sheets("出力 (2)").Cells(x, z).Value = yuno Then
Sheets("出力 (2)").Cells(x - 1, k).Value = Sheets("出力 (2)").Cells(x - 1, z).Value
If maeflg = 0 Then
For i = 0 To 99
tbl(i) = ""
Next i
i = 0
tbl(i) = Sheets("出力 (2)").Cells(maegyo, z + 1).Value
Else
i = i + 1
tbl(i) = Sheets("出力 (2)").Cells(maegyo, z + 1).Value
End If
maeflg = 1
Else
If maeflg = 1 Then
i = i + 1
tbl(i) = Sheets("出力 (2)").Cells(maegyo, z + 1).Value
Sheets("出力 (2)").Cells(x - 1, k).Value = Sheets("出力 (2)").Cells(x - 1, z).Value
'以下、固定の市町村名を求める
l = 1
Do
For j = 1 To 99
If tbl(j) <> "" Then
If Mid(tbl(j - 1), l, 1) <> Mid(tbl(j), l, 1) Then
Exit Do
Else
End If
Else
Exit For 'tbl(j)がヌルならもうデータ無
End If
Next j
'If tbl(j + 1) = "" Then
' Exit Do '次がヌルなら終了
'End If
l = l + 1
If l > 24 Then
Exit Do
End If
Loop
'↓帳票用地域名
Sheets("出力 (2)").Cells(x - 1, 2).Value = Mid(Sheets("出力 (2)").Cells(x - 1, z + 1).Value, 1, l - 1)
If Sheets("出力 (2)").Cells(x - 1, z).Value = 120823 Then '郵便番号がこれならば
Sheets("出力 (2)").Cells(x - 1, 2).Value = "湯沢市"
ElseIf Sheets("出力 (2)").Cells(x - 1, z).Value = 120823 Then '郵便番号がこれならば
Sheets("出力 (2)").Cells(x - 1, 2).Value = "上北郡東北町中村"
End If
l = Len(Sheets("出力 (2)").Cells(x - 1, 2).Value) + 1 '長さを上のif後に合わせる
'↓画面用地域名
Sheets("出力 (2)").Cells(x - 1, 3).Value = Sheets("出力 (2)").Cells(x - 1, 2).Value & Mid(tbl(j), l, 25)
For j = 1 To 99
If tbl(j) <> "" Then
Sheets("出力 (2)").Cells(x - 1, 3).Value = Sheets("出力 (2)").Cells(x - 1, 3).Value & "、" & Mid(tbl(j), l, 25)
Else
Exit For 'tbl(j)がヌルならもうデータ無
End If
Next j
If InStr(Sheets("出力 (2)").Cells(x - 1, z + 3).Value, "以下に掲載がない場合") <> 0 Then '以下に掲載がない場合 があるなら後ろに付与
Sheets("出力 (2)").Cells(x - 1, 3).Value = Sheets("出力 (2)").Cells(x - 1, 3).Value & "以下に掲載がない場合"
End If
maeflg = 0
End If
End If
maegyo = x
End If
yuno = Sheets("出力 (2)").Cells(x, z).Value 'x行目の郵便番号を退避
Next x
Beep
dblEnd = Timer '終了時刻を取得
dblTime = dblEnd - dblStart '所要時間を計算
MsgBox "終了しました。時間は" & Format$(Int(Int(dblTime * 10 ^ 4 + 0.5) / 10 ^ 4)) & "秒だよ。"
End Sub
|
|