Excel (VBA)

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

 
(Windows 10 Pro : Excel 2016)
特定の文字を含むセルを順番に並べていくマクロについて
投稿日時: 21/07/16 16:50:15
投稿者: youkey14

お世話になります。
 
特定の文字を含むセルを順番に並べていきたいのですが、なかなか上手くできないのでご教示いただければ幸いです。
 

A列
a111
a222
a333
a444
a555
b111
b222
b333
b444
b555

 
B列
a
b
c
d

 
C列には特定の文字(B列)を含むセルをA列から探し、
順番にC列/D/E/F...のように振り分ける(もしくはコピー)マクロを作りたいです。
 
念のため、完成形を記します。
 
C列   D列  E列
a111  a222  a333
b111  b222  b333

 
and more...
 
お分かりになる方ご教示願います。
よろしくお願いいたします。[/code]

回答
投稿日時: 21/07/16 17:29:22
投稿者: ハヤシライス

こんにちは
考え方のみですが...
 
条件似合った値をC列以降にコピー
各列ごとに並べ替え
 
という感じでしょうか。

回答
投稿日時: 21/07/16 17:35:18
投稿者: K.Hiwasa
投稿者のウェブサイトに移動

こんな感じでどうでしょうか。
 
(1)A列を上から1件ずつ処理する。
(2)A列の処理対象1件について、B列を上から順にB列の値を含んでいるかを検査する。
(3)含んでいる場合、C列以降の空いているセルにA列の値をセットする。
 
ソートが必要なら最初にA列やB列をソートする

回答
投稿日時: 21/07/16 20:20:55
投稿者: WinArrow
投稿者のウェブサイトに移動

英字はまとまっているという前提で、
行列入れ替えを使ってコピーする方法を提案します。
 

Sub test()
Dim rx1 As Long, Rcnt As Long, RX2 As Long

    For rx1 = 1 To WorksheetFunction.CountA(Columns("B"))
        Rcnt = WorksheetFunction.CountIf(Columns("A"), Cells(rx1, "B").Value & "*")
        If Rcnt > 0 Then
            RX2 = WorksheetFunction.Match(Cells(rx1, "B").Value & "*", Columns("A"), 0)
            Range("A" & RX2).Resize(Rcnt).Copy
            Range("C" & rx1).PasteSpecial _
                Paste:=xlPasteAll, _
                Operation:=xlNone, _
                SkipBlanks:=False, _
                Transpose:=True
            Application.CutCopyMode = False
        End If
    Next
    
    

End Sub

投稿日時: 21/07/16 21:27:49
投稿者: youkey14

皆さん、早速メッセージありがとうございます。
 
WinArrowさんから頂いたメッセージで私のしたかったことが全てクリアできました。
ありがとうございました。