0

数年前、さまざまなフォーラムを閲覧して、列を長さ、最長から最短 (セル内の文字数) でソートするマクロを作成しました。行を列としてリストするために、新しいシートに転置して特別に貼り付けていました。次に、VBS コードをマクロに 100 回貼り付けて、1 回の実行で 100 列を処理できるようにしました。

今日、私はこのマクロを実行しようとしましたが、今はまったく機能しません:(

これは私が使用した VBS コードです (100 個のペーストなし):

Sub SortByLength2()
Dim lLoop As Long
Dim lLoop2 As Long
Dim str1 As String
Dim str2 As String
Dim MyArray
Dim lLastRow As Long

lLastRow = Range("A65536").End(xlUp).Row
MyArray = Range(Cells(2, 1), Cells(lLastRow, 1))
 'Sort array
For lLoop = 1 To UBound(MyArray)
    For lLoop2 = lLoop To UBound(MyArray)
        If Len(MyArray(lLoop2, 1)) > Len(MyArray(lLoop, 1)) Then
            str1 = MyArray(lLoop, 1)
            str2 = MyArray(lLoop2, 1)
            MyArray(lLoop, 1) = str2
            MyArray(lLoop2, 1) = str1
        End If
    Next lLoop2
Next lLoop
 'Output sorted array
Range("JO1:JO" & UBound(MyArray) + 1) = (MyArray)
    Range("A:A").Delete Shift:=xlToLeft
End Sub

行を列に転置したり、同じ VBS コードを 100 回貼り付けたりせずに、行を並べ替えるためのより良い解決策があるはずです...

無制限の行と列を持つ各セルの文字の長さで行のセルを単純にソートできるマクロを手伝ってくれる人はいますか? 最長のセルが 1 番目、最短のセルが最後になる必要があります

私の場合、A から BA までの 745 行と列範囲があります。

前もって感謝します

リクエストに応じて、スクリーンショットを更新します。 ここに画像の説明を入力

4

2 に答える 2

3

これは遅いです。785行で数秒かかりますが、その理由はわかりません。しかし、それは機能します。各行を新しいシートにコピーし、LENそのシートに数式を追加して、数式で並べ替えます。次に、行を元のシートにコピーします。

Sub SortAllCols()
Dim wsToSort As Excel.Worksheet
Dim wbTemp As Excel.Workbook
Dim wsTemp As Excel.Worksheet
Dim row As Excel.Range
Dim Lastrow As Long

    Set wsToSort = ActiveSheet 'Change to suit
    Set wbTemp = Workbooks.Add
    Set wsTemp = wbTemp.Worksheets(1)
    Application.ScreenUpdating = False

    With wsToSort
        Lastrow = .Range("A" & .Rows.Count).End(xlUp).row
        For Each row In .Range("A1:A" & Lastrow)
            wsTemp.UsedRange.EntireRow.Delete
            row.EntireRow.Copy Destination:=wsTemp.Range("A1")
            wsTemp.UsedRange.Offset(1, 0).FormulaR1C1 = "=LEN(R[-1]C)"
            wsTemp.UsedRange.EntireRow.Sort Key1:=wsTemp.UsedRange.Rows(2), order1:=xlDescending, Orientation:=xlSortRows
            wsTemp.Rows(1).Copy Destination:=row
        Next row
    End With
    Application.ScreenUpdating = True
    wbTemp.Close False
    End Sub
于 2013-11-03T16:41:31.743 に答える