0

我想按降序对行进行排序“直到碰到每个空白行”。

我有以下代码：

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 语句通过比较行的第二个数字以降序交换行。

出了问题的是“直到循环”。我想继续检查/交换行，直到它碰到一个空白行，但继续检查/交换空白行之后的行。检查，交换，在碰到空白行时停止，然后再次检查下一行，再次交换，依此类推。

编辑
这是我正在尝试做的事情：
之前：

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**----------
4

2 回答 2

2

现有的代码永远不会终止，因为您正在检查的变量，

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

你c从 2 到 5 循环，所以Cells(i,1)永远不会被触及。

这是非常基本的，以至于有点难以理解你真正想要做什么，但我会试一试。

似乎您希望使用冒泡排序对第 2 到 5 列（可能是 1 到 5）中的每一列进行排序 - 检查两个相邻的单元格，将较小的单元格移到顶部，继续到列的底部。您没有说明每列是否具有相同的长度，所以我假设它没有。

我们应该能够一次对一列进行排序（这不是最有效的算法，但我认为它符合您的意图）：

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

对于每一列，这会找到行数；然后它从底部开始，并将较小的数字一直推到顶部。它回到底部，但这次只从顶部向上推到一个。它一直持续到最后两个单元格 - 现在应该对所有内容进行排序。

如果单元格不包含数值等，您可能需要添加一些错误捕获，但原则上这应该有效。

编辑

根据您的评论，这不是您想要的。我创建了第二个 Sub，它仅根据 B 中的值对列 B 到 E 进行排序 - 这更好地反映了您的代码示例，并且可能是您的想法。我正在使用 B 列的长度来找出要排序的行数 - 我仍然不清楚您的 A 列在做什么以及测试它如何帮助您。

如果这仍然不是你想要的，我建议你用一个简单的例子（屏幕截图）来编辑你的问题，“这就是我的工作表的开头”和“这就是它的样子”。电子表格的四五行以及 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 中有一个内置的排序功能，但我假设您有理由不想用...

我希望这是你需要的！如果不是，请更新您的问题，并以“我希望这个变成那个”的例子。

编辑 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

它变成了这个：

在此处输入图像描述

进入这个：

在此处输入图像描述

注意 -On Error Resume Next因为找到工作表底部的时间会产生错误lastRow；firstRow但既然我们已经完成了，我们只需要退出while循环......

于 2013-04-22T05:41:01.120 回答
0

有很多方法可以做到这一点，但如果你想保持嵌套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（因此第 1 行中的单元格），我们将其与之后的每一行进行比较，因此我们从j + 1(是第 2 行），然后我们看第 3 行、第 4 行等等。当外部循环查看第 10 行时，内部循环将只查看第 11 行和排序范围末尾之间的值。

外部循环结束于，lngTotalRows - 1因为内部循环将查看该单元格之后的单元格，该单元格将是范围中的最后一个单元格。

看看您是否可以在现有代码中实现它。如果事情没有按预期运行，请在单步执行代码时使用断点并检查值。它可能非常有启发性。您还可以Debug.Print在代码中使用语句将值输出到即时窗口以帮助追踪问题。

于 2013-04-22T01:54:57.263 回答