0

質問があります。

「概要」という名前のシートに、ワークブックのシートの名前があります。「Stats」というシートにいくつかの統計があります。要約シートの名前をループし、各シートを選択してから、「統計」ページから B2:M2 の値をコピーし、「要約」シートから選択したシートの列 D2 に転置コピーします。次に、「概要」ページのシートのリストから次のシートに移動し、B3:M3 をコピーして、選択したシートの D2 列を転置してコピーします。

このビットのコードを取得することができました。強制ではありません。toからB2:M2toなどにインクリメントする方法がわかりません。B3:M3B4:M4

誰か助けてください。私は以前に VB コードを書いたことがありません。

Sub transpose() 
Dim MyCell As Range, MyRange As Range 
Dim row_counter As Long, col_counter As Long

Set MyRange = Sheets("Summary").Range("A1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

row_counter = 2
col_counter = 2

For Each MyCell In MyRange
    Sheets("Stats").Select
    Range("B2:M2").Select
    Selection.Copy

    Sheets(MyCell.Value).Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, transpose:=True

    row_counter = row_counter + 1
    col_counter = col_counter + 1
Next MyCell

End Sub
4

1 に答える 1

1

以下のコードを参照してください (これは、オフセットを追加したコードです)。からasb など
Offsetにインクリメントできます。行ごとに移動する だけなので、行と列の変数を置き換えました。B2:M2B3:M3
x

サブトランスポーズ()

Dim MyCell As Range、MyRange As Range
薄暗い x の長さ

Set MyRange = Sheets("Summary").Range("A1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

x = 0

MyRange 内の MyCell ごとに
    Sheets("Stats").Select
    Range("B2:M2").Offset(x, 0).Select
    選択.コピー

    Sheets(MyCell.Value).Select
    Range("D2").Select
    Selection.PasteSpecial 貼り付け:=xlPasteAll、操作:=xlNone、SkipBlanks:= _
    偽、転置:=真

    x = x + 1

次のマイセル

サブ終了

また、これを試すことができます：

Dim MyCell、範囲としての MyRange
Dim wb as Workbook
Dim ws、wsTemp、wsStat をワークシートとして
寸法 x の長さ

wb = Thisworkbook を設定します
Set ws = wb.Sheets("Summary")
wsStat = wb.Sheets("Stats") を設定します

ws付き
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set MyRange = .Range("A1:A" & lrow)
で終わる

x = 0
MyRange 内の MyCell ごとに
    wsTemp = wb.Sheets(MyCell.Value) を設定します
    wsStat.Range("B2:M2").Offset(x, 0).Copy
    wsTemp.Range("D2").PasteSpecial xlPasteAll, , , True
    x = x + 1
    wsTemp = Nothing に設定
次のマイセル

サブ終了

すでにテスト済み。
それがあなたが達成したいことをすることを願っています。

于 2013-11-06T06:12:18.843 に答える