
No.1ベストアンサー
- 回答日時:
こんなカンジで。
Sub macro2()
Dim i, j
For i = 1 To Range("A65536").End(xlUp).Row Step 3
For j = 1 To 2
Cells(i, "A").Offset(j, 0).Cut Destination:=Cells(i, "A").Offset(0, j)
Next j
Next i
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
No.3
- 回答日時:
自分なら、一回配列に読み込んで貼り付けなおします。
Sub Sample()
Dim vData, nLast, i
nLast = Range("A" & Rows.Count).End(xlUp).Row
vData = Range(Cells(1, 1), Cells(nLast, 1))
Range(Cells(1, 1), Cells(nLast, 1)).Clear
For i = 0 To (nLast - 1)
Cells(Int(i / 3) + 1, i Mod 3 + 1) = vData(i + 1, 1)
Next i
End Sub
No.2
- 回答日時:
keithin さんには遠く及びませんが、挑戦してみた
Sub Macro1()
Dim 最終行 As Long
最終行 = Range("A" & Rows.Count).End(xlUp).Row
If 最終行 < 4 Then Exit Sub
Range("B:C").ClearContents
Columns("D:D").Insert Shift:=xlToRight
Range("B1:B" & Int((最終行 + 1) / 3)).FormulaR1C1 = "=INDEX(C1,ROW()*3-3+COLUMN())"
Range("C1:C" & Int(最終行 / 3)).FormulaR1C1 = "=INDEX(C1,ROW()*3-3+COLUMN())"
Range("D1:D" & Int((最終行 - 1) / 3)).FormulaR1C1 = "=INDEX(C1,ROW()*3-3+COLUMN())"
Range("B1:D" & Int((最終行 + 1) / 3)).Value = Range("B1:D" & Int((最終行 + 1) / 3)).Value
Range("A2:A" & Int((最終行 + 2) / 3)).Value = Range("D1:D" & Int((最終行 - 1) / 3)).Value
Columns("D:D").Delete Shift:=xlToLeft
Range("A" & Int((最終行 + 5) / 3), "A" & 最終行).ClearContents
End Sub
長い。。。 けど、処理は速いかな
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
microsoft office for mac につ...
-
エクセルの式がわかる方がおら...
-
office2019 のoutlookは2025年1...
-
Microsoft Officeを2台目のPCに...
-
大学のレポート A4で1枚レポー...
-
パソコンWindows11 Office2021...
-
Office2021を別のPCにインスト...
-
Microsoft365、ページ設定がで...
-
マイクロソフト オフィスのサポ...
-
エクセル 日付順に並べてかえた...
-
Microsoft Office
-
Officeを開くたびの「再起動メ...
-
Office2024インストール後の疑問点
-
パソコンを買い替える際、前の...
-
officeソフトについて教えてく...
-
Excel テーブル内の空白行の削除
-
Microsoft365について
-
表の作成について
-
officeソフト 本名変更
-
Excelで〇のついたものを抽出し...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
おすすめ情報