Question

我想知道当我运行此代码时，是否有一种方法可以选择我的列最终结果。我希望列按照它们被复制的顺序结束，但是它们按照它们来自另一个工作表的顺序粘贴。我已设法在粘贴后交换列，但它需要如此多的代码并且宏很慢。

SearchString = "start"
Set aCell = phaseRange.Find(What:=SearchString, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
    Set bCell = aCell
    ReDim Preserve arrStart(nS)
    arrStart(nS) = aCell.Row
    nS = nS + 1
    Do While ExitLoop = False
        Set aCell = phaseRange.FindNext(After:=aCell)
        If Not aCell Is Nothing Then
            If aCell.Row = bCell.Row Then Exit Do
            ReDim Preserve arrStart(nS)
            arrStart(nS) = aCell.Row
            nS = nS + 1
        Else
            ExitLoop = True
        End If
    Loop
Else

我如何打印出来：

For i = 1 To nS - 1
        Sheets("DataSheet").Select
        Union(Sheets("raw_list").Cells(arrStart(i), NameCol), Sheets("raw_list").Cells(arrStart(i), PhaseCol), Sheets("raw_list").Cells(arrStart(i), ToStartCol), Sheets("raw_list").Cells(arrStart(i), ToDefineCol), Sheets("raw_list").Cells(arrStart(i), ToMeasureCol), Sheets("raw_list").Cells(arrStart(i), ToAnalyseCol), Sheets("raw_list").Cells(arrStart(i), ToImproveDevCol), Sheets("raw_list").Cells(arrStart(i), ToImproveIndCol), Sheets("raw_list").Cells(arrStart(i), ToControlCol), Sheets("raw_list").Cells(arrStart(i), ToClosedCol)).Copy
        Cells(r, 1).Select
        ActiveSheet.Paste
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        r = r + 1
    Next
End If

谢谢！

Answer 1

制作一个两个diminsional数组，大小就是整个工作表的大小，你要处理数组头的第一个元素。
对于粘贴表中的每一列循环遍历数组中的列，直到它们匹配
一旦它们匹配循环通过数组的第二维（列）并将它们粘贴到输出表。

这是一些让你走上正确道路的psudo代码

Sub COlumn2ColumnTest
    Dim LastColumnOfInput as long
    Dim LastRowOfInput as long
    '- set both of these to the last rows / columns of input sheet
    LastColumnOfInput  = Sheets("InputSheet").Cells(1, 256).End(xlToLeft).Column
    LastRowOfInput = Sheets("InputSheet").Cells(Rows.Count, "A").End(xlUp).Row

    Dim ArrayStorage()() as string
        Redim ArrayStorage (LastColumnOfInput)(LastRowOfInput )

    'load input into array
    Dim i as long
    Dim j as long

    for i = 1 to LastColumnOfInput 
        for j = 1 to LastRowOfInput 
            ArrayStorage(i)(j) = sheets("InputSheet").Cells(j,i).value
        next j
    next i

    'loop through output sheet headers
    '- set this equal to number of columns in output
    Dim lastColumnOfOutput as Long
    lastColumnOfOutput = Sheets("OutputSheet").Cells(1, 256).End(xlToLeft).Column

    Dim k as long

    for k = 1 to lastColumnOfOutput 'for each column of output
        for i = 1 to LastColumnOfInput 
            '- loop through all the input coluns until the header match
            If Sheets("Output").Cells(1,k).value = ArrayStorage(i)(1)
                '- if they match then loop through outputting rows to output sheet
                for j = 1 to LastRowOfInput 
                    Sheets("Output").Cells(j,k) = ArrayStorage(i)(j)
                next j
            End If
        next i
    next k
End Sub

EXCEL VBA从数组粘贴，更改粘贴顺序

1 个答案: