VBA Excel - 列を正しい順序で範囲に入れよう

Question

最近、私は定義された範囲を使用して、セルの選択、コピー、貼り付けの代わりにデータをコピーする方法を検討してきました。このようにして、コードのパフォーマンスとランタイムを最適化したいと考えています。

残念ながら私は自分で解決できない問題に直面してきました。

範囲を定義するときに、異なる順序で列を並べ替える必要があります。例えば

：私は範囲内に充填する列がシートに互いに背後にあるように

Set my_range = Sheets("Sheet1").Range("A2:E2,G2:H2,J2:K2,M2") 

は、うまく機能します。私は新しいシートにこれらの範囲を満たしている場合

Set yo_range = Sheets("Sheet2").Range("D2,AV2,L2,H2,Q2,AE2,AG2") 

yo_rangeが、私はそれにではなく、私がダウンして書かれた順番に入れて列を記入します。しかし、今、私はこれを持っています。それは元のものに従った順序でそれを置くでしょう。この例では、yo_rangeは、この順序でデータを新しいシートに入れます。

D2 | H2 | L2 | Q2 | AE2 | AG2 | AV2

どうすればこの問題を解決できますか？私は元のものよりも別のものにしたい。 また、あなたが見ることができるようにmy_rangeはyo_rangeより多くの列を持っています。 yo_rangeを新しいシートに埋め込むことはできますが、特定の時点で列を残しておくことはできますか？

my_range（A2：E2）、例えばA2に入る：E2を

yo_range（D2、AV2）が入る新しいシートに新しいシートにB、次いでCを残して新しいシートのD：Eにyo_range（L2、H2）を貼り付けてください

私は自分の問題をうまく説明でき、誰かが私を助けてくれることを願っています。どんな助けもありがとうございます。

編集：ここでは

は、新しいシートに範囲から値を置くのコードは

Do 
    If Application.WorksheetFunction.CountA(my_range) > 0 Then 
    my_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) 
    Set my_range = my_range.Offset(1, 0) 
    Else 
    Exit Do 
    End If 
Loop 


Do 
    If Application.WorksheetFunction.CountA(yo_range) > 0 Then 
    yo_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) 
    Set yo_range = yo_range.Offset(1, 0) 
    Else 
    Exit Do 
    End If 
Loop 

Answer 1

我々は Copy方法は、左対のデータを再アレンジすることを見ることができます

右。これを試してみてください：

Option Explicit 

Public Sub CheckClipboard() 

    Dim ws As Worksheet 
    Dim rngToCopy As Range 
    Dim objData As Object 
    Dim varContents As Variant 

    ' test data b,c,d,e,f,g in Sheet1!B1:G1 
    Set ws = ThisWorkbook.Worksheets("Sheet1") 
    ws.Range("B1:G1").Value = Array("b", "c", "d", "e", "f", "g") 

    Set rngToCopy = ws.Range("E1:F1,G1,B1:C1") '<-- note not left-to-right order 
    rngToCopy.Copy '<-- copy 

    ' this is a late bound MSForms.DataObject 
    Set objData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 

    ' copy current cell formula to clipboard 
    objData.GetFromClipboard 
    varContents = objData.GetText 

    Debug.Print varContents '<-- re-arranged left-to-right 

    ' cancel copy 
    Application.CutCopyMode = False 

End Sub 

私はすぐに窓にこれを取得する：

b c d e f g 

ので、Copyを使用すると、あなたがやりたいことのために仕事に行くされていません。あなたはRangeで設定した順序で「ペースト」するためには

データは、各AreaでRangeの各Areaを反復し、各セル（すなわちRange）する必要があります。あなたの問題を複製し、解決策を提示し、それ以下のテストコードを参照してください：

Option Explicit 

Sub MixColumns() 

    Dim ws As Worksheet 
    Dim rngIn As Range 
    Dim rngOut As Range 
    Dim lng As Long 
    Dim rngArea As Range 
    Dim rngCell As Range 

    Set ws = ThisWorkbook.Worksheets("Sheet1") 

    ' example 1 
    Set rngIn = ws.Range("B1:C1,E1:F1,G1") '<-- 5 cells, non-contiguous, forward order 
    Set rngOut = ws.Range("B2:F2") '<-- 5 contiguous cells 

    rngIn.Copy rngOut '<-- works 


    ' example 2 - OP problem 
    Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order 
    Set rngOut = ws.Range("B3:F3") '<-- 5 contiguous cells 

    rngIn.Copy rngOut '<-- should be e,f,g,b,c but gets b,c,e,f,g 


    ' example 3 - solution for OP problem 
    Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order 
    Set rngOut = ws.Range("B4:F4") '<-- 5 contiguous cells 

    lng = 1 '<-- rngOut cell counter 
    ' iterate areas 
    For Each rngArea In rngIn.Areas 
     ' iterate cells in area 
     For Each rngCell In rngArea.Cells 
      rngOut.Cells(1, lng).Value = rngCell.Value '<-- copy single value 
      lng = lng + 1 '<-- increment rngOut counter 
     Next rngCell 
    Next rngArea '<-- results in e,f,g,b,c 


End Sub 

は、この出力を与える：