Question

我有一个包含8列和300行的工作表。列之一（“ D”）标记为“分组”，其值为“是”或“否”。 “已分组”行，即“已分组”列上值为“是”的行通常由2-5行组成，并出现在“否”行之间。我希望使用VBA来调整从第2行到最后使用的Row的行顺序，但要遵循以下条件：

分组的行不能混洗。
分组行的位置可能会更改，例如可以将第50-53行的分组行移至第1-4行，而将第100-103行的分组行移至第150-153行。

之前： Before sort

之后： After sort

我尝试为新列中的行分配随机值，并基于该新列进行排序，但我不满足条件。我已经尝试过使用选择进行行交换，即“过滤掉”分组的行，但最终还是被改组。

Answer 1

此宏应该对您有用：

<code>Sub Shuffle()
Dim Lrow As Long
Dim AR1() As Variant
Dim AR2() As Variant
Dim R1 As Range
Dim Num As Long
Dim AA As Integer
Dim BB As Long
Dim CC As Integer
Dim DD As Integer
Lrow = ActiveSheet.Range("A200000").End(xlUp).Row
Set R1 = ActiveSheet.Range("A2:H" & Lrow)
ReDim AR1(1 To (Lrow - 1), 1 To 8)
ReDim AR2(1 To (Lrow - 1), 1 To 8)
AR1 = R1
For BB = LBound(AR1, 1) To UBound(AR1, 1)
    AA = 1
    If AR1(BB, 3) = "Yes" Then
        Num = BB
        Do Until Num = 0
            Num = Num + 1
            If Num > UBound(AR1, 1) Then
                Num = 0
            Else
                If AR1(Num, 3) = "No" Then
                    Num = 0
                Else
                    AA = AA + 1
                End If
            End If
        Loop
        Do Until Num <> 0
            Num = Int((UBound(AR1, 1) - LBound(AR1, 1) + 1) * Rnd + LBound(AR1, 1))
            For CC = 1 To AA
                If (Num + CC - 1) > UBound(AR1, 1) Then
                    Num = 0
                    Exit For
                Else
                    If AR2(Num + CC - 1, 3) <> "" Then
                        Num = 0
                        Exit For
                    End If
                End If
            Next CC
        Loop
        For CC = 1 To AA
            For DD = 1 To 8
                AR2(Num + CC - 1, DD) = AR1(BB + CC - 1, DD)
            Next DD
            AR1(BB + CC - 1, 3) = ""
        Next CC
    End If
Next BB
For BB = LBound(AR1, 1) To UBound(AR1, 1)
    If AR1(BB, 3) <> "" Then
        AA = 0
        Num = 0
        Do Until Num <> 0
            Num = Int((UBound(AR1, 1) - LBound(AR1, 1) + 1) * Rnd + LBound(AR1, 1))
            If AR2(Num, 3) = "" Then
                For DD = 1 To 8
                    AR2(Num, DD) = AR1(BB, DD)
                Next DD
                AR1(BB, 3) = ""
            Else
                Num = 0
                AA = AA + 1
            End If
            If AA > 10 Then
                For CC = LBound(AR1, 1) To UBound(AR1, 1)
                    If AR2(CC, 3) = "" Then
                        For DD = 1 To 8
                            AR2(CC, DD) = AR1(BB, DD)
                        Next DD
                        AR1(BB, 3) = ""
                        Num = CC
                        Exit For
                    End If
                Next CC
            End If
        Loop
    End If
Next BB
R1 = AR2
End Sub
</code>

祝你好运

根据列值随机排列行

1 个答案: