| |
りん さんへ
私の使い方がおかしいのか、うまく実行できません。
そのままコピーして貼り付けて使っています。
りんさんからの条件もすべて満たしていますが・・・
「実行時エラー'1004'
ブックのシートをすべて削除または非表示にすることは出来ません。
選択したシートを非表示、削除、または移動するには、まず新しいシートを挿入するか、非表示のシートを表示してください。」
というエラーが出ます。
デバックすると、下から五行目
.Delete '元データをコピーしたシートを削除
が黄色で塗りつぶされています。
お助け下さい。
よろしくお願い致します。
>エクセル初心者 さん、こんにちわ。
>
>・１行目は見出し
>・Ｃ列に住所が都道府県から入っている
>・IV列まで使われていない
>アクティブシートの内容が、上記条件を満たすとして。
>
>Sub TEST()
> Dim Rmax As Long, Cmax As Long, RR1 As Long, RR2 As Long
> Dim ws1 As Worksheet, ws2 As Worksheet
> Dim r1 As Range
> '
> ActiveWorkbook.ActiveSheet.Copy '表示しているシートを新しいブックにコピー
> Set ws1 = ActiveWorkbook.ActiveSheet 'セット
> With ws1.UsedRange
> Rmax = .Cells(.Count).Row
> Cmax = .Cells(.Count).Column
> End With
> With ws1
> .Cells(1, Cmax + 1).Value = 1
> .Cells(2, Cmax + 1).Value = 2
> '連番をふる
> Set r1 = .Range(.Cells(1, Cmax + 1), .Cells(Rmax, Cmax + 1))
> .Range(.Cells(1, Cmax + 1), .Cells(2, Cmax + 1)).AutoFill _
> Destination:=r1
> '１行目は見出し、Ｃ列でソート
> r1.EntireRow.Sort Key1:=.Range("C1"), Order1:=xlAscending, Header:=xlYes, _
> OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
> :=xlStroke
> '
> Do
> RR1 = 2: RR2 = 2
> 'C列が住所（都道府県が必ず入っていること）
> If .Cells(RR1, 3).Value = "" Then Exit Do
> Do
> '左３文字で比較する
> If Left(.Cells(RR1, 3).Value, 3) <> _
> Left(.Cells(RR2 + 1, 3).Value, 3) Then Exit Do
> RR2 = RR2 + 1
> Loop
> '
> With .Parent
> Set ws2 = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
> End With
> '
> ws2.Name = Left(.Cells(RR1, 3).Value, 3)
> '
> .Rows(1).Copy
> ws2.Cells(1, 1).PasteSpecial Paste:=-4104
> ws2.Cells(1, 1).PasteSpecial Paste:=8 '列幅
> With .Range(.Cells(RR1, 1), .Cells(RR2, 1)).EntireRow
> .Cut Destination:=ws2.Cells(2, 1)
> .Delete
> End With
> '元の並びに戻す
> With ws2
> .UsedRange.Sort Key1:=.Cells(1, Cmax + 1), Order1:=xlAscending, Header:=xlYes, _
> OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
> :=xlStroke
> .Columns(Cmax + 1).Delete 'ソートキー削除
> End With
> Application.CutCopyMode = False
> Loop
> Application.DisplayAlerts = False
> .Delete '元データをコピーしたシートを削除
> Application.DisplayAlerts = True
> End With
> Set ws2 = Nothing: Set ws1 = Nothing
>End Sub
>
>こんな感じです。
>動作としては、
> 連番をふる
> 都道府県列でソート（ふりがなは使わない）
>
>その後、
>
> 連続範囲を判定して新しいシートに振り分ける
> 元の並びにソート
> ソートキーを削除
>を繰返しています。
|
|
エクセル初心者
- 05/8/8(月) 13:26 -
