EXCEL VBA从数组中粘贴，更改粘贴顺序 [英] 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

如何打印出来：

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

谢谢！

推荐答案

1. 制作一个两个diminional数组，整个表格的大小适用于数组的第一个元素的头。


2. 在粘贴表中循环通过数组中的列，直到匹配


3. 一旦它们通过数组（列）的第二个维度进行匹配，并将它们粘贴到输出表。

这是一些psudo代码，让你在正确的路径上

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

这篇关于EXCEL VBA从数组中粘贴，更改粘贴顺序的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！