2012-07-11 8 views
0

이 코드를 실행할 때 내 열을 순서대로 선택할 수있는 방법이 있는지 궁금합니다. 필자는 복사 된 순서대로 열을 끝내기를 원하지만 다른 시트의 순서대로 열을 붙여 넣습니다. 열을 붙여 넣은 후 열을 바꿀 수 있었지만 너무 많은 코드가 필요하고 매크로가 느리다.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 

감사합니다!

+0

당신이 좀 더 명확하게 할 수 옳은 길에 당신을 얻을 수있는 몇 가지 psudo 코드는? –

+1

전체 영역을 배열로 읽어들이는 것이 훨씬 쉽고, 대상 시트의 셀에 값을 할당하는 적절한 순서로 배열을 순환합니다 (잘라 내기 및 붙여 넣기의 필요성 무시). –

답변

1
  1. 전체 시트의 크기를 2 차원 배열로 만드십시오. 배열의 첫 번째 요소 인 헤더에 대처하고 있습니다.
  2. 루프의 두 번째 차원을 통해 루프가 일치하면 출력 시트를 붙여 넣습니다.

여기

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 
관련 문제