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

我想知道是否有一种方法，我可以选择以至少我的列将在我运行此代码时结束。我希望列按照它们被复制的顺序结束，但它们按照它们来自另一个表的顺序粘贴。我已经设法交换粘贴后的列，但它需要这么多的代码，并且宏慢。EXCEL VBA从数组粘贴，更改粘贴顺序

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

的感谢！

来源

2012-07-11 Andreas

你能澄清些吗？ – 2012-07-11 09:18:16

将整个区域读入一个数组并不是一件容易的事情，然后以适当的顺序在目标工作表中为单元赋值（绕过需要剪切和粘贴）的循环遍历数组？ – 2012-07-11 10:10:52

制作一个两个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

来源

2012-07-11 13:38:58 danielpiestrak

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

回答

相关问题