2

私は VBA の経験が少しありますが、この問題について何か助けていただければ幸いです。基本的には、シート 1 の 2 列のデータをシート 2 の行のデータに変換する必要があります。

現在、Excel では次のように表示されます。

ここに画像の説明を入力

そして、次のようにする必要があります。

ここに画像の説明を入力

見出しをシート 2 に転送するコードは既に作成済みで、正常に動作します。実際の値を正しい形式で転送する際に問題が発生しています。今、私のコードの本体は

ws.Range("B3").Copy
ws2.Range("C2").PasteSpecial xlPasteValues

ws.Range("B4").Copy
ws2.Range("D2").PasteSpecial xlPasteValues

ws.Range("B5").Copy
ws2.Range("E2").PasteSpecial xlPasteValues

ws.Range("B6").Copy
ws2.Range("F2").PasteSpecial xlPasteValues

延々と続きました。しかし、私が作業している実際のドキュメントには何万ものデータ ポイントがあるため、これは実際には機能しません。このプロセスを自動化する方法があることは知っていますが、私が試したすべてのことで、何も実行されなかったか、エラー 1004 が発生しました。

これについての助けをいただければ幸いです!!

編集: データには何百もの小さなセクションがあり、それぞれ 18 行の長さです (フレーム番号に 1 行、時間に 1 行、16 チャンネルごとに 1 行)。ステップ サイズ 18 のループに入れようとしています。それは可能ですか? ループは問題ありませんが、セルの値をコピーして貼り付けるループを行ったことはありません

4

6 に答える 6

1

このコードを試してください：

Dim X() As Variant
Dim Y() As Variant
X = ActiveSheet.Range("YourRange").Value
Y = Application.WorksheetFunction.Transpose(X)

このリンクもチェックしてください：VBAで範囲を転置

于 2013-07-11T15:00:24.770 に答える
0

この方法では、ループと配列を利用してデータを転送します。これは最も動的な方法ではありませんが、仕事は完了します。すべてのループは既存の定数を使用するため、データ セットが変更された場合は定数を調整でき、正常に実行されるはずです。ワークシート名は、Excel ドキュメントで使用している名前と一致するように調整してください。実際には、これはデータを配列にロードし、それを別のワークシートに転置することです。

データ セットのサイズが大幅に変化する場合は、ループ変数と配列サイズの宣言を調整するためのロジックを含める必要があります。その場合はお知らせください。その方法を見つけて、編集を投稿します。

Sub moveTimeData()

Set source = ThisWorkbook.Sheets("RawData")
Set dest = ThisWorkbook.Sheets("TransposeSheet")

Const dataSetSize = 15

Const row15Start = 3
Const row15End = 18
Const row30Start = 21
Const row30End = 36

Const colStart = 2

Const destColStart = 2
Const dest15RowStart = 2
Const dest30RowStart = 3

Dim time15Array() As Integer
Dim time30Array() As Integer
ReDim time15Array(0 To dataSetSize)
ReDim time30Array(0 To dataSetSize)

Dim X As Integer
Dim Y As Integer
Dim c As Integer
c = 0

For X = row15Start To row15End
    time15Array(c) = source.Cells(X, colStart).Value
    c = c + 1
Next X

c = 0
For X = row30Start To row30End
    time30Array(c) = source.Cells(X, colStart).Value
    c = c + 1
Next X

For X = 0 To dataSetSize
    dest.Cells(dest15RowStart, X + destColStart).Value = time15Array(X)
Next X

For X = 0 To dataSetSize
    dest.Cells(dest30RowStart, X + destColStart).Value = time30Array(X)
Next X

End Sub

編集->編集を読んだ後、これがあなたが探しているものだと思います

Sub moveTimeData()

Set source = ThisWorkbook.Sheets("RawData")
Set dest = ThisWorkbook.Sheets("TransposeSheet")

Const numberDataGroups = 4
Const dataSetSize = 15
Const stepSize = 18

Const sourceRowStart = 3

Const sourceColStart = 2

Const destColStart = 2
Const destRowStart = 2



Dim X As Integer
Dim Y As Integer
Dim currentRow As Integer
currentRow = destRowStart



For X = 0 To numberDataGroups
    For Y = 0 To dataSetSize
        dest.Cells(currentRow, Y + destColStart).Value = source.Cells((X * stepSize) + (Y    + sourceRowStart), sourceColStart)
    Next Y
    currentRow = currentRow + 1
Next X


End Sub

この作業の鍵は、データ ダンプ後に処理するデータ グループの数を知ることです。それを検出するためのロジックを含めるか、numberDataGroups という定数を調整して、グループの数を反映させる必要があります。注: データが Row Major 形式で格納されている配列をトラバースするために、同様の手法を利用しました。

于 2013-07-11T15:55:57.513 に答える
0

コピーしてから、特殊貼り付け + 転置を使用して、列を行に変換します。
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True

于 2013-07-11T14:44:54.130 に答える
0 
    'The following code is working OK
    Sub TansposeRange()
    '
    ' Transpose Macro
    '
    Dim wSht1 As Worksheet
    Dim rng1 As Range
    Dim straddress As String
    Set wSht1 = ActiveSheet

    On Error Resume Next
    Set rng1 = Application.InputBox(Prompt:="Select Columns or Rows to transpose", _
                                   Title:="TRANSPOSE", Type:=8)
    If rng1 Is Nothing Then
        MsgBox ("User cancelled!")
        Exit Sub
    End If
    straddress = InputBox(Prompt:="Full cell Address as Sheet2!A1", _
          Title:="ENTER Full Address", Default:="Sheet1!A1")
    If straddress = vbNullString Then
         MsgBox ("User cancelled!")
         Exit Sub
    End If      

    Application.ScreenUpdating = False
    rng1.Select
    rng1.Copy

    On Error GoTo 0

    'MsgBox straddress
    Range(straddress).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.ScreenUpdating = True
    End Sub
于 2015-06-25T19:51:14.823 に答える