2

選択した行（画像の最初の列）を複製して、以下の2番目と3番目の列のようなデータとして結果を取得したいと思います。マクロを使おうとしましたが、2000行を超える場合があります。私を助けてください

http://i45.tinypic.com/2pph3cg.png

ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(-1, 0).Range("A1").Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A9"), Type:=xlFillCopy
ActiveCell.Range("A1:A9").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A9"), Type:=xlFillCopy
ActiveCell.Range("A1:A9").Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "100"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "200"
ActiveCell.Offset(-1, 0).Range("A1:A2").Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A9")
ActiveCell.Range("A1:A9").Select

===========コードでは、300ではなく9つの繰り返し行を追加します。（100,200、.. 900）

  1. 選択した行を1つ移動（オフセット）します

  2. 9行追加します

  3. 選択した行を1（-1）戻します

  4. 次に、セルA1：A9の値100,200、...を埋め始めます。これは、相対参照を使用したため、アクティブなセルに応じてセル範囲が変化するためです。

私の試み：

I do not know how to change the reference A1:A3 to relative one

アクティブセルが変更されると、それに応じて変更する必要があります。

Sub AddDuplicate()

''参照A1：A3を相対参照に変更する方法がわかりません。アクティブセルが変更されると、それに応じて変更する必要があります。

私の試み http://i49.tinypic.com/2mwxs39.png

4

1 に答える 1

3

少なくともあなたは試しました:)そしてそれが私が見たかったものです:)これはあなたがしようとしていることですか？

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim NewRow As Long, j As Long

    '~~> Name of the sheet where the the data lies
    Set ws = Sheets("Sheet1")

    With ws
        '~~> Get the last Row in Col A
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Row from where we need to write
        NewRow = 1

        '~~> Loop though each item in Col A
        For i = 1 To lastRow
            '~~> Write to Col C; 3 rows at a time
            .Range("C" & NewRow & ":C" & NewRow + 2).Value = .Range("A" & i).Value

            '~~> Get the next empty row
            NewRow = NewRow + 3
        Next

        '~~> Type "A","B","C" in Col D
        .Range("D1").Value = "A": .Range("D2").Value = "B": .Range("D3").Value = "C"

        '~~> Autofill till the last row
        .Range("D1:D3").AutoFill Destination:=Range("D1:D" & NewRow - 1)
    End With
End Sub

スナップショット

ここに画像の説明を入力

于 2012-05-02T21:28:56.970 に答える