Question

我正在尝试编写一小段代码，它们将真正执行3种不同的功能。

在Sheet1中我有4列数据，这是一个可变数量的行，第4列包含需要分隔的数据，因为它包含分号，这也是一个可变数据量。

我希望能够将这4列复制到Sheet2，逐行确保我已分隔第4列，然后转置它从第4列中删除所有数据并替换为转置数据。

除此之外，我希望它能够循环，以便所有都被复制和转置等，这样Sheet2上的数据之间有1行间隙，这个差距将来自第4个结束列作为可变数据量。

如果有人可以提供帮助，我将非常感激。

这是我目前正在处理的代码，它允许我复制第一行的4列，然后粘贴到Sheet2上。

Sub Test1()
    Sheets("FT Raw").Select
    Range("A2").Select

    Do Until IsEmpty(ActiveCell)
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Sheets("FT WDs").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False

        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

Answer 1

编辑：更新以在转置和添加工作表之前对数组进行排序。

包括http://en.allexperts.com/q/Visual-Basic-1048/string-manipulation.htm

中的QuickSort子

Sub Test1()
    Dim shtSrc, shtDest, rngSrc, rwDest, r, arr, num

    Set rngSrc = Sheets("FT Raw").Range("A2")
    Set shtDest = Sheets("FT WDs")
    r = shtDest.Cells(Rows.Count, 4).End(xlUp).Row + 2           
    Do While Len(rngSrc.Value) > 0
        shtDest.Rows(r).Cells(1).Resize(1, 3).Value = _
                     rngSrc.Resize(1, 3).Value
        arr = Split(rngSrc.Offset(0, 3).Value, ";")
        QuickSort arr, 0, UBound(arr) 'include method from link above...
        num = UBound(arr) + 1
        shtDest.Rows(r).Cells(4).Resize(num, 1).Value _
               = Application.Transpose(arr)
        r = r + num + 1

        Set rngSrc = rngSrc.Offset(1, 0)
    Loop
End Sub

复制行，粘贴到不同的工作表，然后将文本复制到列，然后转置

1 个答案: