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 次元配列を作成します。
  2. 貼り付けシートの各列に対して、一致するまで配列内の列をループします
  3. それらが一致したら、配列の 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
于 2012-07-11T13:38:58.260 に答える