0

我想知道是否有一种方法可以在我运行此代码时按照我的列的最终顺序进行选择。我希望这些列以它们被复制的顺序结束，但它们按照它们从另一张表中的顺序粘贴。粘贴后我设法交换了列，但它需要太多代码并且宏很慢。

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

谢谢！

4

1 回答 1

1
  1. 制作一个二维数组，其大小与您正在处理的整个工作表的大小相同，该数组的第一个元素是标题。
  2. 对于粘贴表中的每一列，循环遍历数组中的列，直到它们匹配
  3. 一旦它们匹配遍历数组的第二维（列）并将它们粘贴到输出表中。

这是一些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
于 2012-07-11T13:38:58.260 回答