[[20040204105443]]　『品名で並べ替え』（Ｋ）　ページの最後に飛ぶ

『品名で並べ替え』（Ｋ）

価格表を作っているのですが

　　　　Ｃ　　　　　　Ｇ　　　　　　Ｈ　　　　　　Ｉ

　1　品名　　　　旧価格　　　新価格　　　備考

　　　　
こんな感じで何行もあります。

品名の頭は数字・アルファベットです。

これを数字の１～、次にアルファベットのＡ～と

並べ替えたいのですがセルを結合してたりと

上手くできません。教えてください。

 セルの結合を解除した体裁でレイアウトしてから、並び替えしてください。

 私は印刷用の様式以外では、デメリットが多いのでセルの結合は使いません。
 データを操作する必要のあるシートで結合を使うのは、手間が増えるだけですよ。

  (INA)

 これはＣ～Ｆ列を結合してあるんでっか？
 マクロを使えば簡単ですワ。と言うよりマクロを使わんかったらでけへん？
 まあ、何でも試してみんことにはなぁ。
 データは
 1○○○
 B○○○
 3×××
 D△△△
 2×××
 結合セルはＣ～Ｆ列と勝手に解釈して作りましたで・・。

 [Alt]+[F11]でVBEを開きます
 「挿入」→「標準モジュール」で無垢の画面を表示
 下のコードをコピペします
 [Alt]+[Q]でエクセルに戻る。
 「ツール」「マクロ」「セキュリティ」を中レベルに設定

 これで準備完了ですワ。
 [Alt]+[F8]でsortを実行してみておくんなはれ。
 並べ替えするデータの最上行（品名と書いた見出しの下の行）をクリックしてもろたら
 お望みの並べ替えがでけまっせぇ。
 違うとったらアイムソリー。
 　　　　　（弥太郎）
 '------------------------------
 Sub sort()
    Dim n As Long, i As Long, f As Long
    Dim Rng As Range, tbl As Range
    Dim data

    Set Rng = Application.InputBox(prompt:="並べ替えする品名欄の先頭行を選択して下さい。", Type:=8)
    n = Rng.End(xlDown).Row

    Set tbl = Rng.Resize(n - Rng.Row + 1, 7)
    Range(Cells(1, 250), Cells(tbl.Rows.Count, 254)).Clear
    f = 1
    For i = 1 To tbl.Rows.Count
        tbl.Cells(i, 1) = StrConv(tbl.Cells(i, 1), vbNarrow)
        If IsNumeric(Left(tbl.Cells(i, 1), 1)) Then
            Cells(f, 251) = tbl.Cells(i, 1)
            Range(tbl.Cells(i, 5), tbl.Cells(i, 7)).Copy Destination:=Cells(f, 252)
            f = f + 1
        End If
    Next i

    For i = 1 To f - 1
        Cells(i, 250) = Val(Cells(i, 251))
    Next i

    Range(Cells(1, 250), Cells(i - 1, 254)).sort key1:=Cells(1, 250), order1:=xlAscending
    x = f
    For i = 1 To tbl.Rows.Count
        data = StrConv(tbl.Cells(i, 1), vbNarrow)
        If Not IsNumeric(Left(data, 1)) Then
            Cells(f, 251) = tbl.Cells(i, 1)
            Range(tbl.Cells(i, 5), tbl.Cells(i, 7)).Copy Destination:=Cells(f, 252)
            f = f + 1
        End If

    Next i

    Range(Cells(x, 251), Cells(tbl.Rows.Count, 254)).sort key1:=Cells(x, 251), order1:=xlAscending

    For i = 1 To tbl.Rows.Count
        tbl.Cells(i, 1) = Cells(i, 251)
    Next i

    Range(Cells(1, 252), Cells(tbl.Rows.Count, 254)).Copy Destination:=tbl.Cells(1, 5)
    Range(Cells(1, 250), Cells(tbl.Rows.Count, 254)).Clear
    Set Rng = Nothing

 End Sub

(弥太郎）さん、マクロ有難うございました。

実行してみたのですが、上手くいかず・・・

マクロは超初心者なので、何処が悪いのかもわかりません。

結局セルの結合を解除して並べ替えすることにしました。　　（Ｋ）

コメント返信：

[ 一覧(最新更新順) ]

[[20040204105443]] 『品名で並べ替え』（Ｋ） ページの最後に飛ぶ

[[20040204105443]]　『品名で並べ替え』（Ｋ）　ページの最後に飛ぶ