EXCEL VBA Paste from array, change paste order

问题

I'm wondering if there is a way that I can choose in wich order my columns will end up in when I run this code. I want the columns to end up in that order they are copied, but they paste in the order they are from the other sheet. I have managed to swap the columns after they are pasted, but it requires so much code and the macro is slow as it is.

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

How I print it out:

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

thanks!

回答1:

Make a two diminsional array the size of the whole sheet you are coping with the first element of the array the header.
for each column in the paste sheet loop through the columns in the array until they match
Once they match loop through the second dimension of the array (columns) and paste them down the output sheet.

Here is some psudo code to get you on the right path

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

来源：https://stackoverflow.com/questions/11426973/excel-vba-paste-from-array-change-paste-order

标签

excel

vba

excel-vba