Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
A列にベタ打ちしたテキストを複数列に分割したい。
投稿日時: 21/01/27 23:08:42
投稿者: 高円寺の郷のもの

質問です。
 
+ーーー+ーーー+ーーー+
| A | B | C |
+ーーー+ーーー+ーーー+
| あ |   |   |
+ーーー+ーーー+ーーー+
| い |   |   |
+ーーー+ーーー+ーーー+
| う |   |   |
+ーーー+ーーー+ーーー+
|   |   |   |
+ーーー+ーーー+ーーー+
| か |   |   |
+ーーー+ーーー+ーーー+
| き |   |   |
+ーーー+ーーー+ーーー+
| く |   |   |
+ーーー+ーーー+ーーー+
|   |   |   |
+ーーー+ーーー+ーーー+
 
となっているものを、
 
+ーーー+ーーー+ーーー+
| A | B | C |
+ーーー+ーーー+ーーー+
| あ | い | う |
+ーーー+ーーー+ーーー+
| か | き | く |
+ーーー+ーーー+ーーー+
|   |   |   |
+ーーー+ーーー+ーーー+
|   |   |   |
+ーーー+ーーー+ーーー+
|   |   |   |
+ーーー+ーーー+ーーー+
|   |   |   |
+ーーー+ーーー+ーーー+
|   |   |   |
+ーーー+ーーー+ーーー+
|   |   |   |
+ーーー+ーーー+ーーー+
 
というふうに横に並べて書きたいのですが、なにか良いVBAはないでしょうか?

回答
投稿日時: 21/01/28 05:59:41
投稿者: simple

Sub test()
    Dim lastCell As Range
    Dim area As Range
    Dim pos As Long

    Set lastCell = Cells(Rows.Count, "A").End(xlUp)
    pos = 1
    For Each area In Range("A1", lastCell).SpecialCells(xlCellTypeConstants).Areas
        area.Copy
        Cells(pos, "C").PasteSpecial Paste:=xlPasteAll, Transpose:=True
        pos = pos + 1
    Next
    Application.CutCopyMode = False
End Sub
ポイントは、
行と列を入れ替えての貼付です。これは手作業でも出てきます、マクロ記録でコードが
わかります。
 
あとは、まとまった単位でコピーするところです。
これは、色々な方法があると思いますが、
Areasプロパティ(連結領域毎に分離したAreasコレクションを返します)を利用する方法を
使ってみました。内容を確認して下さい。
 
確認の便宜のため、あえて、C列にコピーしています。
必要に応じて修正してください。
 
(私は確認未済と断らない限り、実際に動作することを確認して投稿しています)
余談:高円寺には好きな喜多方ラーメン店があります。最近ご無沙汰です。

投稿日時: 21/01/28 12:41:00
投稿者: 高円寺の郷のもの

ありがとうございます。完璧でございます。
だいぶ作業がはかどります。真にありがとうございました!
 
※高円寺おいしいラーメン屋さんたくさんありますよね!
おすすめは、「麺屋はやしまる」さんです!