あなたの映画力を試せる!POPLETA映画検定(無料) >>

A列とB列に文字が入っているのですが、下記のようにA列とB列とC列に文字を移動させたいです。
(A列の数字は必ず奇数のA列に入っています。)
VBAのコードを教えて下さい。

例えば
A1 1  B1 cat
A2 空白 B2 猫
A3 空白 B3 dog
A4 空白 B4 犬
A5 2  B5 whale
A6 空白 B6 クジラ
A7 3  B7 rabbit
A8 空白 B8 ウサギ

とデータがある場合

A1 1  B1 cat  C1 猫
A2 空白 B2 dog  C2 犬
A3 2  B3 whale  C3 クジラ
A4 3  B4 rabbit C4 ウサギ

としたいです。

実際、データは、A5196まであります。

このQ&Aに関連する最新のQ&A

A 回答 (2件)

No.1です。



>実際、データは、A5196まであります。

前回のコードは一つずつカット&ペーストしていますので
かなりの時間を要すると思います。
↓のコードに変更してみてください。

Sub Sample2()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
With Range(Cells(1, "C"), Cells(lastRow, "C"))
.Formula = "=IF(MOD(ROW(),2)=1,B2,"""")"
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

少しは短縮できると思います。m(_ _)m
    • good
    • 0
この回答へのお礼

ご回答有難う御座います。
>少しは短縮できると思います。m(_ _)m
すごいです。Sub Sample2()は一瞬で出来ました。

Sub Sample1()でも十分で御座います。

お礼日時:2016/11/03 21:37

こんばんは!



一例です。

Sub Sample1()
Dim i As Long, lastRow As Long
Application.ScreenUpdating = False
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row Step 2
With Cells(i, "B")
.Cut .Offset(-1, 1)
End With
Next i
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Range(Cells(1, "B"), Cells(lastRow, "B")) _
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか?m(_ _)m
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング