Excel子例程，将逗号分隔的值转置到行
Excel子例程，将逗号分隔的值转置到行
提问于 2018-10-05 22:57:08
我有一个问题，在工作中，我被要求获取一个数据集并进行一些修改。问题是有一个包含值1,2,3,4-10,13-17,20的字段，我必须展开单元格中的多个区域，将数字转置到行中，并用它复制行的其余部分。
示例：
FIELD1 FIEL2 FIELD3 FIELD4
test1 test2 test3 1,2,3,4-10应该变成：
FIELD1 FIEL2 FIELD3 FIELD4
test1 test2 test3 1
test1 test2 test3 2
test1 test2 test3 3
test1 test2 test3 4
test1 test2 test3 5
test1 test2 test3 6并对所有剩余行重复相同的操作，直到找到空单元格。
下面你可以看到我的科学怪人的子程序，我已经开发了一部分，一部分是从其他来源拼接而成的。问题是，这在一定程度上是可行的，但它不能在超过一行的情况下正确地完成工作。您可以尝试：
Select the first cell and run the routine from a button
1,2,3
4,5,6有什么帮助吗？提前谢谢。
Sub Ops()
'DECLARE VARIABLES
Dim i As Long, st As String
i = 1
Dim startP As Range
Dim c As Collection
Dim count As Integer
Set c = New Collection
ary = Split(ActiveCell.Value, ",")
Do Until IsEmpty(ActiveCell.Value)
count = 0
For Each r In Selection
If i = 1 Then
st = r.Text
i = 1
Else
st = st & "," & r.Text
End If
Next r
Set startP = Selection(1, 2)
ary = Split(st, ",")
i = 1
For Each a In ary
count = count + 1
startP(i, 1).Value = a
i = i + 1
Next a
'COUNT MINUS 1
scount = count - 1
'REPEAT UNTIL REACH COUNT
For ba = 1 To scount
'COPY AND INSERT ROWS BELOW
ActiveCell.Copy
Selection.Insert Shift:=xlDown
Next ba
Selection.Offset(count, 1).Select
'ONCE THE LOOP IS FINISH GO TO NEXT CELL
Selection.Offset(0, -1).Select
Loop
End Sub你可以看到下面的数据
在邮政编码单元格中，我需要展开多个范围，并在同一行下面复制和插入X倍于单元格中的邮政编码数量。
回答 1
Stack Overflow用户
发布于 2018-10-05 23:24:12
这段代码满足了您的要求--请注意，我没有定义好的单元格引用，因为我们基于ActiveCell，所以我将Ranges保留为Range而不是worksheet.Range
Sub x()
Do While ActiveCell.Value2 <> ""
If InStr(1, ActiveCell.Value2, ",") > 0 Or InStr(1, ActiveCell.Value2, "-") > 0 Then e
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub e()
Dim a As Long
Dim r As Long
Dim c As Long
Dim rc As Long
Dim i As Long
Dim j As Long
Dim x() As String
Dim t() As String
x = Split(ActiveCell, ",")
r = ActiveCell.Row
c = ActiveCell.Column
For i = LBound(x) To UBound(x)
If InStr(1, x(i), "-") Then
a = a + Split(x(i), "-")(1) - Split(x(i), "-")(0)
End If
Next i
a = a + UBound(x)
Range(Cells(r + 1, c), Cells(r + a, c)).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For i = LBound(x) To UBound(x)
t = Split(x(i), "-")
If UBound(t) = 0 Then
Cells(r + rc, c).Value2 = t(0)
rc = rc + 1
Else
For j = t(0) To t(1)
Cells(r + rc, c).Value2 = j
rc = rc + 1
Next j
End If
Next i
Range(Cells(r, c - 3), Cells(r + rc - 1, c - 1)).Value2 = _
Range(Cells(r, c - 3), Cells(r, c - 1)).Value2
End Sub这基本上是根据数字x,y,a-b,z逐个填充该列，方法是先在,上拆分，然后在-的任何实例上拆分
在此之后，它已经获得了行计数器rc，所以只需使用该计数器从上到下泛洪范围，复制活动单元格之前的3列中的值
编辑:在实际填写信息之前，我添加了5行代码，它们实际上遍历了范围(1,2,4-7 )，以计算有多少行需要INSERT。
EDIT2:我添加了另一个名为x的子例程来使这个e例程循环，直到它到达一个没有任何内容的单元格...因此，要修复整个工作表，只需突出显示最上面的单元格，范围如(1,3,4-7...等)并运行x例程
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/52668372
复制相关文章
相似问题
腾讯云开发者
