[[20110822184912]]　『1行飛ばしで貼り付け』（管さん）　ページの最後に飛ぶ

 『1行飛ばしで貼り付け』（管さん）

 A列の値をB列に一行飛ばしでマクロで貼り付けたいのですが,ご指導お願いします。

 B1 : =IF(MOD(ROW(),2)=0,"",INDEX(A:A,(ROW()+1)/2))
これを、下に、ずぅっとひっぱる。

 (ぶらっと)

 B1:=INDEX(A:A,(ROW(B1)+1)/2)&""
 B2:(ブランク)　入力しない
 B1:B2を指定　　下へフィルコピー　　　　　　　　　　(NB)

 マクロで貼り付けたいのですが,ご指導お願いします。

 失礼。見落としていた。
スタンダードなループ処理。

 Sub Sample()
    Dim c As Range
    Dim i As Long, z As Long

    Columns("B").ClearContents
    z = Range("A" & Rows.Count).End(xlUp).Row
    Set c = Range("B1")
    For i = 1 To z
        c.Value = Cells(i, "A").Value
        Set c = c.Offset(2)
    Next

 End Sub

 追記）かわりばえしないけど、もう１つ。

 Sub Sample2()
    Dim i As Long, z As Long
    Dim v() As String

    Columns("B").ClearContents
    z = Range("A" & Rows.Count).End(xlUp).Row
    ReDim v(1 To z * 2, 1 To 1)
    For i = 1 To z
        v((i - 1) * 2 + 1, 1) = Cells(i, "A").Value
    Next

    Range("B1").Resize(z * 2).Value = v

 End Sub

 もう１つおまけ。行挿入は好きじゃないんだけど。

 Sub Sample3()
    Dim i As Long, z As Long
    Dim v() As String

    Columns("B").ClearContents
    z = Range("A" & Rows.Count).End(xlUp).Row
    Range("B1").Resize(z).Value = Range("A1").Resize(z).Value
    ReDim v(2 To z)
    For i = 2 To z
        v(i) = "B" & i
    Next

    Range(Join(v, ",")).Insert Shift:=xlDown

 End Sub

 これで打ち止めにするけど

 Sub Sample4()
    Dim i As Long, z As Long
    Dim v() As String

    Columns("B").ClearContents
    z = Range("A" & Rows.Count).End(xlUp).Row
    Range("B1").Resize(z * 2).Formula = "=IF(MOD(ROW(),2)=0,"""",INDEX(A:A,(ROW()+1)/2))"

 End Sub

 (ぶらっと)

 関数から、たくさんのマクロまで有難うございました。
 勉強させていただきます。』
（管さん）

コメント返信：

[ 一覧(最新更新順) ]

[[20110822184912]] 『1行飛ばしで貼り付け』（管さん） ページの最後に飛ぶ

[[20110822184912]]　『1行飛ばしで貼り付け』（管さん）　ページの最後に飛ぶ