2017-05-02 3 views
0

私は61のデータフィールドを持つメンバーの大きなリスト(垂直)を持っています。私は別のシートに各メンバーを扇動/転置する必要があります。Excel、コピーしようとすると、セル数Xの転置

サンプルデータ:

Name: 
Last Name: 
Address: 
Membership Date: 
Maiden Name: 
... 
61 items 

ファイルは、B別のシートに、私はちょうど列をコピーしたい

長い50Kで2列幅ですので、私は繰り返しに各メンバーのデータフィールドのタイトルを得たファイル。

これは私が持っているものであり、どこに行くのか分かりません。

Sub CopyTranspose() 
    Dim rng As Range 
    Dim i As Long 

    Set rng = ThisWorkbook.ActiveSheet.Range("B1:B51000") 
    With rng 

     ' Loop through all cells of the range 
     For i = 1 To 51000 Step 1 
      'Select member data fields 
      Range("B2:B61").Select 

      ' Copy and transpose 
      Selection.Copy 
      Sheets("Sheet1").Select 
      Range("A2").Select 
      Range("A2").Select 
      Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
       False, Transpose:=True 
     Next i 
    End With 
End Sub 

私は、各反復とするとき、最後の空白行に移動貼り付けのためにすべてに61を追加する必要が知っている、それは適切ではないと知っています。私は、I-61 + x回の反復回数のアカウントのために別の変数を追加すると仮定します。最後の空のセルにジャンプするためにペースト側で何かしますか?

ありがとうございます。

+0

高価な繰り返しではなく、Transpose(https://msdn.microsoft.com/en-us/library/office/ff196261.aspx)を使用しない理由はありますか? – Zerk

+0

私は違いがあったのか分からなかったので。 LOL私はちょうどレコードマクロを使用して、アクションを実行し、それをコピーします。 – Rominall

+0

大きな違い!今は心配する必要はありませんが、より洗練された方法で作業したいかどうか検討する価値があります。データセットが大きくなると、ルーピングはいくつかの大きなスピードの問題につながります。 – Zerk

答えて

0

これは、それぞれのデータポイントを列ごとに1人1人の新しい行にしたいと仮定して動作するはずです。

lRow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row 

For i = 1 To lRow Step 61 

    iStart = i 
    iEnd = i + 60 

    Sheets("Data").Range("B" & iStart & ":B" & iEnd).Copy 

    Sheets("Sheet1").Range("A" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True 

Next i 
+0

です。ペースト以外の作業は転置ではありませんでしたが、修正しました。 – Rominall

+0

さて、数分後に私が投稿して編集したときにそのことが分かりました。 – acvbasql

2

コピー/貼り付けを使用するよりも、データを転置するために、配列を使用するはるかに高速になります。データセットのサイズを考えると、私はスピードを述べ

' Get last row in copy-from sheet 
Dim lastRow as Long 
lastRow = Sheets("DataSheet").Range("A" & Rows.Count).End(xlUp).Row 
' Loop down that sheet, copying blocks of 61 rows 
Dim i as Long 
Dim dataArray as Variant 
For i = 1 To lastRow Step 61 
    ' Assign data to an array 
    dataArray = Sheets("DataSheet").Range("B" & i & ":B" & i + 60) 
    ' Stick the values of that transposed array into the summary sheet 
    With Sheets("TransposedSheet") 
     .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1).value = Application.Transpose(dataArray) 
    End With 
Next i 

...高速なソリューションであることが好ましいと仮定します。比較のために、自分のメソッド、acsqlのコピー/ペーストメソッド、コピー/ペーストメソッドをApplication.ScreenUpdating = Falseと設定して実装しました。最後のオプションは、マクロを高速化するためのよく知られた方法です。

  • アレイ法:0.01171875秒
  • コピー&ペーストする方法(画面真更新)0.7890625秒
  • コピー&ペーストする方法(画面偽更新)0.3671875列Bのちょうど一桁の4000行の結果s

so を使用してください!