按递减顺序对行进行排序,直到空白行继续到下一个空白行

时间:2013-04-22 00:34:59

标签: vba sorting excel-vba logic excel

我想按递减顺序对行进行排序“直到命中每一个空白行。”

我有以下代码:

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

Do Until Loop出了什么问题。我想继续检查/交换行,直到它碰到一个空白行,但在空行后继续检查/交换行。点击空白行时检查,交换,停止,然后再次检查下一行,再次交换,依此类推。

编辑
这是我想要做的事情:
之前:

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

我的If比较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**----------

2 个答案:

答案 0 :(得分: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

我在以下虚拟电子表格上运行了此代码:

enter image description here

它产生了以下输出:

enter image description here

如您所见,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

它变成了这个:

enter image description here

进入这个:

enter image description here

注意 - On Error Resume Next就在那里,因为当lastRow位于工作表底部时找到firstRow会产生错误;但是既然我们已经完成了这个时间,我们只需要退出while循环......

答案 1 :(得分:0)

有很多方法可以做到这一点,但是如果你想保持嵌套的For方法,你需要做的第一件事就是找到空白之前有多少行。

Dim lngTotalRows As Long

lngTotalRows = 0

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

既然你已经拥有了它,你可以基本上使用你现有的代码用lngTotalRows替换你的15。你的循环确实有几个小问题......

你的外环应该是:

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语句将值输出到即时窗口,以帮助跟踪问题。