Question

我遇到问题，在工作中我被要求获取数据集并进行一些修改。问题在于，存在一个包含值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

您可以在下面看到数据

在邮政编码单元格中，我需要扩展多个范围，并在同一行Xtimes的下面复制并插入该单元格中的邮政编码数。

Answer 1

此代码满足您的要求-请注意，我没有定义明确的单元格引用，因为我们将其基于ActiveCell，所以我将Ranges保留为@Entity public class Product { @Id @Column(name = "ID") private String id; @OneToOne(mappedBy = "product") private ProductImage productImage; } @Entity public class ProductImage { @Id @Column(name = "ID", unique = true) private String id; @OneToOne @JoinColumn(name = "product_ID") private Product product; @Column @Lob private Blob data; }而不是Range < / p>

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上进行拆分，然后在,的任何实例上进行拆分

在那之后，它已经有了行计数器-，因此只需使用该计数器将范围从上到下进行泛洪，在活动单元格之前的3列中复制值即可

编辑：我添加了5行，这些行实际上经过了范围（1、2、4-7等），以在实际填写信息之前计算到rc的行数。

EDIT2：我添加了另一个名为INSERT的子例程，使此x例程循环直到到达其中没有任何内容的单元格为止。因此，要固定整个工作表，只需突出显示范围为（1,3,4-7 ...等）的最上方单元格并运行e例程

Excel子例程，将以逗号分隔的值转置为行

1 个答案: