在MS EXCEL中交替混合数据
我有一个包含10.000行的csv文件。 2.000行的值为“EXPL_1”。 3.000行的值为“EXPL_2”。 2.500行的值为“EXPL_3”。 1.500行的值为“EXPL_4”。 2.000行的值为“EXPL_5”。
我正在寻找一个function，将交替混合（重新sorting）的值，并将继续混合，直到完成。
所以最终的结果会是这样的：
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) *值是按名称sorting的（第一个是EXPL_1，第二个是EXPL_2等）*也许将来会出现更多的值。 *我知道列表中有多less个值。
Sub MixData() Dim arr(5) As Long 'IF expl_5 is highest - increase as necessary Dim r As Range Dim x As Integer ActiveSheet.Columns(1).Insert Set r = Range("A1") Do x = Val(Mid(r.Offset(0, 1), 6, 1)) arr(x) = arr(x) + 1 r.Value = arr(x) Set r = r.Offset(1, 0) Loop Until r.Offset(0, 1) = "" ActiveSheet.UsedRange.Sort key1:=Range("a1") ActiveSheet.Columns("A").Delete End Sub
你需要'vba还是可以使用excel标准的方法？ 如果以后最简单的方法在我看来如下：
让我们说你的EXPL_1等是从A1到A ….
- 插入B列并在B1中input
=countif($A$1:A1;A1)。 - 将该公式向下复制，直到列A的末尾
- 按B列asc和A列ascsorting整个数据
- 完成:)
如果你想用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
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
这可以给你一个想法如何工作。 你一定要付出一些努力来分离你的CSV文件在4arrays，但它应该在几分钟内完成。 希望它可以帮助你。
编辑：它现在是一个工作的例子，它打印
EXPL_1 EXPL_2 EXPL_3 EXPL_4 EXPL_1 EXPL_2 EXPL_3 EXPL_1 EXPL_2 EXPL_1
此代码根据值的数量将“手动”值添加到工作表。 因此，如果某些types的值较less，则会留下空格。 我使用了speardsheet中的单元格，但是可以使用相同的逻辑对数组进行操作，而不是创build非连续的范围，可以使用For loop Step将值添加到数组索引
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
然后创build一个数组，并将范围添加到数组。
代码说明
循环5次为五种types的EXPL_
For n = 1 To 5 Next n
插入数值来为每个types创build数组
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
创build数组
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
使用与数组元素相同数量的行创build不连续的范围跳过5行
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