Algorithm 在MS EXCEL中交替混合数据

我有一个csv文件，其中包含10.000行。 2.000行的值为“EXPL_1”。 3.000行的值为“EXPL_2”。 2.500行的值为“EXPL_3”。 1.500行的值为“EXPL_4”。 2.000行的值为“EXPL_5”

我正在搜索一个函数，该函数将交替混合（重新排序）值，并将继续混合它们，直到完成

因此，最终结果将类似于：

EXPL_1,
EXPL_2,
EXPL_3,
EXPL_4,
EXPL_5,
EXPL_1,
EXPL_2,
EXPL_3,
EXPL_4,
EXPL_5,
.......... (x times repeat)
EXPL_1,
EXPL_2,
EXPL_3,
EXPL_5,    (*EXPL_4 values finished but continue to alternately mix the rest)  

*这些值按名称排序（第一个是所有EXPL_1，第二个是所有EXPL_2等） *也许将来会出现更多的价值观。 *我知道列表中有多少值

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim EXPL_1 As Variant
EXPL_1 = Array("EXPL_1", "EXPL_1", "EXPL_1", "EXPL_1")  'For you it should store the csv content
Dim EXPL_2 As Variant
EXPL_2 = Array("EXPL_2", "EXPL_2", "EXPL_2")
Dim EXPL_3 As Variant
EXPL_3 = Array("EXPL_3", "EXPL_3")
Dim EXPL_4 As Variant
EXPL_4 = Array("EXPL_4")

Dim intCounter As Integer
intCounter = 0 'is our array index
Dim valueInserted As Boolean
valueInserted = False 'With this var we check if any value got inserted

Do
      valueInserted = False 'We reset it here so we dont run in an endless loop

      'Here we check if the array contains anything if not we just ignore that array until the others finished

      If UBound(EXPL_1) >= intCounter Then
        Debug.Print (EXPL_1(intCounter)) 'Write this row
        valueInserted = True
      End If
      If UBound(EXPL_2) >= intCounter Then
        Debug.Print (EXPL_2(intCounter)) 'Write this row
        valueInserted = True
      End If
      If UBound(EXPL_3) >= intCounter Then
        Debug.Print (EXPL_3(intCounter)) 'Write this row
        valueInserted = True
      End If
      If UBound(EXPL_4) >= intCounter Then
        Debug.Print (EXPL_4(intCounter)) 'Write this row
        valueInserted = True
      End If


      If valueInserted = False Then
        'If we didn´t inserted any value we exit the loop
        Exit Do
      End If
      intCounter = intCounter + 1
   Loop
End Sub

这可以让你了解它的工作原理。你肯定要花点力气在4数组中分离你的CSV文件，但这应该在几分钟内完成。希望对你有帮助

编辑：它现在是它打印的一个工作示例

EXPL_1
EXPL_2
EXPL_3
EXPL_4
EXPL_1
EXPL_2
EXPL_3
EXPL_1
EXPL_2
EXPL_1

此代码根据值的数量将值“手动”添加到图纸中。因此，如果某些类型的值较少，则会留下空白。我使用了speardsheet上的单元格，但您可以使用相同的逻辑对数组进行操作，而不是创建非连续范围，您可以使用循环步骤的

向数组索引添加值

Dim ws As Worksheet
Dim one_rng As Range
Dim a1(), a2(), i As Long, ub As Long

Set ws = ThisWorkbook.Worksheets(1)
'Insert the number of values
For n = 1 To 5
    If n = 1 Then
    n_array = 20 'insert number of valuer for EXPL_1
    ElseIf n = 2 Then
    n_array = 30 'insert number of valuer for EXPL_2
    ElseIf n = 3 Then
    n_array = 25 'insert number of valuer for EXPL_3
    ElseIf n = 4 Then
    n_array = 15 'insert number of valuer for EXPL_4
    ElseIf n = 5 Then
    n_array = 20 'insert number of valuer for EXPL_5
    End If


    ReDim a1(1 To 1, 1 To n_array) As Variant
    For i = 1 To n_array
     a1(1, i) = CStr("EXPL_" & n)
    Next i
    ub = UBound(a1, 2)
    ReDim a2(1 To ub, 1 To 1) 'resize a2 ("right" shape) to match a1
        ' "flip" the a1 array into a2
        For i = 1 To ub
            a2(i, 1) = a1(1, i)
        Next i

    For i = 5 + n To (5 + n) * (n_array - 1) Step 5
        If i = (5 + n) Then Set one_rng = ws.Range("B" & n)
        Set new_rng = ws.Range("B" & i)
        Set one_rng = Union(one_rng, new_rng)
    Next i
    Debug.Print one_rng.Address 'Verify the Range
    one_rng = a2
Next n

如果需要，可以进行一些更改

您可以自动筛选所用范围（第一行到最后一行）上的空白值，然后将其删除

Sub DeleteBlankRows()
    Range("B:B").Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub


代码解释
对五种类型的EXPL循环5次_
插入要为每种类型创建数组的值数
创建数组
创建非连续范围，跳过与数组元素行数相同的5行
将数组插入范围
您“需要”vba还是可以使用excel标准方法？
如果是后者，我认为最简单的方法如下：

假设你的解释是从A1到A

插入B列并在B1中输入
=countif（$a$1:A1；A1）
将该公式向下复制到A列的末尾
按B列asc和A列asc对完整数据进行排序
完成：）
如果要使用vba执行此操作，可以使用与代码相同的方法：

Sub Mix_it()
    Columns(2).Insert
    Range(Range("B1"), Range("A" & Rows.Count).End(xlUp).Offset(0, 1)).Formula = "=COUNTIF($A$1:A1,A1)"
    Range(Range("X1"), Range("A" & Rows.Count).End(xlUp)).Sort Range("B1"), xlAscending, Range("A1"), , xlAscending ' change 'X' to last column
    Columns(2).Delete
End Sub

根据您与我们共享的数字，您只能为7500行生成1-2-3-4-5组，因为在此之后
EXPL_4
数据将耗尽。你更愿意随机洗牌10K行吗？在我看来，最简单的解决方案是将5个不同的行分开。而不是简单地循环并添加它们。在循环中检查是否定义了数组索引，如果没有，只需跳过它。谢谢@TimBiegeleisen的回答。这不符合我的随机要求。我想这样做：（使用VBA或原始Excel以外的其他编程语言处理起来要容易得多。@Doomenik想法不错……但怎么做呢？好的，如果我理解正确，你的代码应该转到工作表1。但是结果在哪里？（我不是VBA专家）。如何让它运行？
For n = 1 To 5
Next n

    If n = 1 Then
    n_array = 20 'insert number of valuer for EXPL_1
    ElseIf n = 2 Then
    n_array = 30 'insert number of valuer for EXPL_2
    ElseIf n = 3 Then
    n_array = 25 'insert number of valuer for EXPL_3
    ElseIf n = 4 Then
    n_array = 15 'insert number of valuer for EXPL_4
    ElseIf n = 5 Then
    n_array = 20 'insert number of valuer for EXPL_5
    End If

ReDim a1(1 To 1, 1 To n_array) As Variant
For i = 1 To n_array
 a1(1, i) = CStr("EXPL_" & n)
Next i
ub = UBound(a1, 2)
ReDim a2(1 To ub, 1 To 1) 'resize a2 ("right" shape) to match a1
    ' "flip" the a1 array into a2
    For i = 1 To ub
        a2(i, 1) = a1(1, i)
    Next i

  For i = 5 + n To (5 + n) * (n_array - 1) Step 5
        If i = (5 + n) Then Set one_rng = ws.Range("B" & n)
        Set new_rng = ws.Range("B" & i)
        Set one_rng = Union(one_rng, new_rng)
    Next i

one_rng = a2

Sub Mix_it()
    Columns(2).Insert
    Range(Range("B1"), Range("A" & Rows.Count).End(xlUp).Offset(0, 1)).Formula = "=COUNTIF($A$1:A1,A1)"
    Range(Range("X1"), Range("A" & Rows.Count).End(xlUp)).Sort Range("B1"), xlAscending, Range("A1"), , xlAscending ' change 'X' to last column
    Columns(2).Delete
End Sub