vba - 空白行まで降順で行を並べ替え、次の空白行に進みます

Question

「すべての空白行に到達するまで」降順で行を並べ替えたい。

次のコードがあります。

For j = 1 To 15
For i = 1 To 15

   Do Until mySheet.Cells(i, 1).Value = 0

   If mySheet.Cells(j, 2).Value > mySheet.Cells(i, 2).Value Then
       For c = 2 To 5
            temp1 = mySheet.Cells(i, c).Value
            mySheet.Cells(i, c).Value = mySheet.Cells(j, c).Value
            mySheet.Cells(j, c).Value = temp1
       Next c
   End If

   i = i + 1
   Loop

Next i
Next j

If ステートメントは、行の 2 番目の番号を比較することにより、行を降順で交換します。

うまくいかなかったのは、Do until ループです。空白行に達するまで行のチェック/スワップを続けたいのですが、空白行の後の行のチェック/スワップを続けます。チェック、スワップ、空白行にヒットしたときに停止し、次の行をもう一度チェックし、もう一度スワップする、というように。

編集
これが私がやろうとしていることです:
BEFORE:

Row   B           C      D       E
1     63743       734    1848    246
2     86208       900    900     974
3     --------**Empty Row**----------
4     40934       730    5643    5565
5     97734       454    54656   3345
6     73885       347    3728    9934
7     --------**Empty Row**----------
8     34355       998    3884    3299
9     98438       383    43483   4399
10    19874       454    53439   3499
11    --------**Empty Row**----------

後：

Row   B           C      D       E
1     86208       900    900     974
2     63743       734    1848    246
3     --------**Empty Row**----------
4     97734       454    54656   3345
5     73885       347    3728    9934
6     40934       730    5643    5565
7     --------**Empty Row**----------
8     98438       383    43483   4399
9     34355       998    3884    3299
10    19874       454    53439   3499
11    --------**Empty Row**----------

MyIfは列 B の値を比較し、行を降順で並べ替えます。while ループを作成して、空白行にヒットしたときに並べ替えを停止する方法がわかりませんでしたが、空白行の後に次の数行の比較/並べ替えを続けました。空白行の前に何行あるかわからないことに注意してください。

前に2を編集
：

Row   A   B           C      D       E
1     A    63743       734    1848    246
2     B    86208       900    900     974
3     -------------**Empty Row**----------
4     C    40934       730    5643    5565
5     D    97734       454    54656   3345
6     E    73885       347    3728    9934
7     -------------**Empty Row**----------
8     F    34355       998    3884    3299
9     G    98438       383    43483   4399
10    H    19874       454    53439   3499
11    -------------**Empty Row**----------

後：

Row   A   B           C      D       E
1     B   86208       900    900     974
2     A   63743       734    1848    246
3     -------------**Empty Row**----------
4     D   97734       454    54656   3345
5     E   73885       347    3728    9934
6     C   40934       730    5643    5565
7     -------------**Empty Row**----------
8     G   98438       383    43483   4399
9     F   34355       998    3884    3299
10    H   19874       454    53439   3499
11    -------------**Empty Row**----------

Answer 1

チェックしている変数が

Do Until mySheet.Cells(i, 1).Value = 0

次のいずれかが変更されていない場合:

If mySheet.Cells(j, 2).Value > mySheet.Cells(i, 2).Value Then
   For c = 2 To 5
        temp1 = mySheet.Cells(i, c).Value
        mySheet.Cells(i, c).Value = mySheet.Cells(j, c).Value
        mySheet.Cells(j, c).Value = temp1
   Next c
End If

c2 から 5 までをループするので、Cells(i,1)触れられることはありません。

これは非常に基本的なことなので、実際に何をしようとしているのかを理解するのは少し難しいですが、試してみます。

列 2 から 5 (おそらく 1 から 5) のそれぞれをバブル ソートで並べ替えたいようです - 隣接する 2 つのセルをチェックし、小さいセルを一番上に移動し、列の一番下まで移動し続けます。各列の長さが同じかどうかは述べていないので、そうではないと仮定します。

次のように、一度に 1 つの列を並べ替えることができるはずです (これは最も効率的なアルゴリズムではありませんが、あなたの意図には合っていると思います)。

Sub sortMyColumns()
Dim colNum As Integer
Dim numRows As Integer
Dim i, j As Integer
Dim lastCell As Range

For colNum = 1 To 5
    Set lastCell = Cells(1, colNum).End(xlDown)
    numRows = lastCell.Row
    For i = 2 To numRows
        For j = numRows To i Step -1
           If Cells(j, colNum) < Cells(j - 1, colNum) Then
             temp = Cells(j - 1, colNum).Value
             Cells(j - 1, colNum).Value = Cells(j, colNum).Value
             Cells(j, colNum).Value = temp
          End If
        Next j
    Next i
Next colNum
End Sub

各列について、これは行数を見つけます。次に、一番下から開始し、小さい方の数字を一番上に押し上げます。下に戻りますが、今度は上から1つだけ押し上げます。これは、最後の 2 つのセルに到達するまで続きます。これで、すべてが並べ替えられるはずです。

セルに数値が含まれていない場合などにエラー トラップを追加する必要がある場合がありますが、原則としてこれは機能するはずです。

編集

あなたのコメントに基づいて、これはあなたが探していたものではありませんでした. B の値だけに基づいて列 B から E を並べ替える 2 番目の Sub を作成しました。列 B の長さを使用して、並べ替える行数を調べています。列 A が何を行っているのか、それがどのようにテストに役立つのか、まだはっきりとはわかりません。

これでも問題が解決しない場合は、質問を編集して、「これが私のシートの始まりです」、「これがどのように見えるべきか」というタイプの簡単な例 (スクリーン ショット) を使用することをお勧めします。スプレッドシートの 4 ～ 5 行と A 列から E 列だけで十分です。

Sub sortByColumnB()
' sort cells in columns B through E
' based on the value found in B
    Dim colNum As Integer
    Dim numRows As Integer
    Dim i, j As Integer
    Dim lastCell As Range

    ' find the last cell in column B:
    Set lastCell = Cells(1, 2).End(xlDown)
    numRows = lastCell.Row
    For i = 2 To numRows
        For j = numRows To i Step -1
           If Cells(j, 2) < Cells(j - 1, 2) Then
             ' swap around each of the cells in this row with the one above
             For colNum = 2 To 5
                 temp = Cells(j - 1, colNum).Value
                 Cells(j - 1, colNum).Value = Cells(j, colNum).Value
                 Cells(j, colNum).Value = temp
             Next colNum
          End If
        Next j
    Next i

End Sub

このコードを次のダミー スプレッドシートで実行しました。

そして、次の出力が得られました。

ご覧のとおり、列 A は変更されておらず、列 B から E までの各行は、列 B のキーに従って並べ替えられています。もちろん、Excel には並べ替え機能が組み込まれていることはご存じでしょうが、理由があったと思います。使いたくない…

これがあなたが必要としていたものであることを願っています! そうでない場合は、「これをあれに変えたい」の例で質問を更新してください。

EDIT 3 質問に対する最新の更新と私のソリューションへのコメントにより、最終的に何をしようとしているのかが明確になります。「端から落ちる」まで、最後のブロックに到達したことを実際に知ることはできないため、コードを修正して、エラー トラップ付きの無限ループが発生するようにしました (これは、ブロックの下部を超えようとすると生成されます)。スプレッドシート)。私はこれをずっと空白行でテストしました（列Aの空白を含む - コードは列Aをまったく使用していないことに注意してください）：

Sub keepSorting()
Dim colNum As Integer
Dim firstRow, lastRow As Integer
Dim i, j As Integer

' loop around the algorithm we had earlier, but only for the 'non-empty blocks of rows'
firstRow = 1
lastRow = [B1].End(xlDown).Row

On Error GoTo allDone

While True ' break out of the loop when we throw error
' sort from firstRow to lastRow:
    For i = firstRow + 1 To lastRow
        For j = lastRow To i Step -1
           If Cells(j, 2) > Cells(j - 1, 2) Then
             ' swap around each of the cells in this row with the one above
             For colNum = 1 To 5
                 temp = Cells(j - 1, colNum).Value
                 Cells(j - 1, colNum).Value = Cells(j, colNum).Value
                 Cells(j, colNum).Value = temp
             Next colNum
          End If
        Next j
    Next i
    firstRow = Cells(lastRow + 1, 2).End(xlDown).Row
    lastRow = Cells(firstRow, 2).End(xlDown).Row

Wend

allDone:
On Error GoTo 0
End Sub

これは次のようになります。

これに：

注 -が存在するのは、シートの下部にあるwhenOn Error Resume Nextを見つけるとエラーが発生するためです。しかし、その時までに完了したので、while ループを終了する必要があります...lastRowfirstRow

Answer 2

これを行うには多くの方法がありますが、ネストされたアプローチを維持したい場合For、最初に行う必要があるのは、空白に到達する前に何行あるかを調べることです。

Dim lngTotalRows As Long

lngTotalRows = 0

While Cells(lngTotalRows + 1, 1) <> ""
    lngTotalRows = lngTotalRows + 1
Wend

これで、基本的に既存のコードを使用して、15 を lngTotalRows に置き換えることができます。ただし、ループにはいくつかの小さな問題があります...

外側のループは次のようになります。

For j = 1 to lngTotalRows - 1

内部ループは次のようになります。

For i = j + 1 to lngTotalRows

いくつかの具体的な例を見れば、おそらくその理由がわかるでしょう。外側のループセルをその後の各セルと比較しているため、ループを初めて通過すると、最初のセルがj = 1(したがって、Row 1のセル)、その後のすべての行と比較するため、j + 1(から開始します。行 2 )、次に行 3、行 4 などを見ていきます。外側のループが行 10を見ているとき、内側のループは行 11と並べ替え範囲の終わりの間の値だけを調べます。

外側のループは で終了します。lngTotalRows - 1これは、内側のループが範囲内の最後のセルになるセルの後のセルを調べるためです。

既存のコードでそれを実装できるかどうかを確認してください。期待どおりに動作しない場合は、ブレークポイントを使用し、コードをステップ実行しながら値を調べます。それは非常に啓発的です。またDebug.Print、コード内でステートメントを使用して値を即時ウィンドウに出力し、問題の追跡に役立てることもできます。