EXCEL VBAを用いての並び替えからの挿入表示

質問

EXCEL VBAを用いての並び替えからの挿入表示についての質問です。

A列に文字と数字の組み合わせデータが入っています。
カテゴリーが４つ「AC○」「BC○」「CC○」「DC○」（○は数字です）があります。
A列は「AC○」「BC○」「CC○」「DC○」の順番で並んでいます。
（ただし3つのカテゴリしかないデータの場合もあり。）

そこにC１セルにデータ「AC10」、E１セルにデータ「AC12」、G1セルにデータ「BC10」、I1セルにデータ「DC10」が入ってマクロ実行した場合、添付の『マクロ実行後』のように挿入させたいです。
つまり４つのカテゴリのいずれかを判断し、A列の各カテゴリの一番最後の行に挿入させたいです。
該当したカテゴリがなければ、「AC○」「BC○」「CC○」「DC○」のカテゴリの順で最初の部分に入れる。

このような処理をするにはＶＢＡ記述はどのようにすればよいでしょうか？
私のVBAの知識レベルはマクロ記録をしてそれを元に少し修正や機能追加できたりするくらいの初心者です。
よろしくお願いいたします。

回答No.3

keithin

＞これを値のみで挿入というのは可能なのでしょうか？

エクセルにできることならマクロでできます。

元のご相談：
＞C１セルにデータ…、E１セルにデータ…、G1セルにデータ…、I1セルにデータ…が入ってマクロ実行した場合

回答したのは，あなたがご相談に書いたとおりのマクロです。実はご相談が違ってた，もっと別のことをしたかったのでしたら，このご相談は解決で閉じてから，新しいご相談として詳しい状況を添えて投稿し直してください。
そもそもあなたが（マクロになったつもりで）自分の手を動かしエクセルを操って，どんな具合に操作すればあなたの思い通りになりますか。その手順をそのままマクロに翻訳すれば，できあがります。あなたは，「正しい手順」をしっかり丁寧にご相談に説明してください。

＃作成例：
sub macro1r1()
　dim h as range
　dim buf as variant
　dim Target as range

　application.calculation = xlcalculationmanual

　for each h in range("C1,E1,G1,I1")

　　buf = left(h.value, 2)
　　do until buf = ""
　　　set target = range("A:A").find(what:=buf, after:=range("A1"), lookin:=xlvalues, lookat:=xlpart, searchdirection:=xlprevious)
　　　if target is nothing then
　　’AC/BC/CC/DCがＡ列に無かった

　　　　if buf = "AC" then
　　　　'ACなのに無かった
　　　　　h.copy
　　　　　range("A1").insert shift:=xlshiftdown
　　　　　buf = ""

　　　　elseif buf = "BC" then
　　　　’BCが無かった時は，ACの最後を探すことにする
　　　　　buf = "AC"

　　　　elseif buf = "CC" then
　　　　　buf = "BC"

　　　　elseif buf = "DC" then
　　　　　buf = "CC"
　　　　end if

　　　else
　　　’AC/BC/CC/DCがＡ列にあった
　　　　h.copy
　　　　target.offset(1).insert shift:=xlshiftdown
　　　　buf = ""
　　　end if
　　loop
　next

　with range("A1:A" & range("A65536").end(xlup).row)
　.value = .value
　end with
　application.calculation = xlcalculationautomatic

end sub

お礼

コメントありがとうございます。
説明不足で申し訳ございません！
もう少し自分の中でも整理をし、もし解決できなければ改めて質問を立てさせていいただきます。
とても参考になりました。ありがとうございます～

回答No.2

keithin

＞C１セルに…、E１セルに…、G1セルに…、I1セルに…が入ってマクロ実行した場合

この４カ所が「毎回指定でこの４カ所しかない」のか，それともＡＣ１０などのデータが「どこに入っているのか探すのもマクロにやらせたい」のか，そういった具体的な状況も「マクロの作成」では重要なポイントになります。

sub macro1()
　dim h as range
　dim buf as variant
　dim Target as range

　for each h in range("C1,E1,G1,I1")

　buf = left(h.value, 2)
　do until buf = ""
　　set target = range("A:A").find(what:=buf, after:=range("A1"), lookin:=xlvalues, lookat:=xlpart, searchdirection:=xlprevious)
　　if target is nothing then
　’AC/BC/CC/DCがＡ列に無かった

　　　if buf = "AC" then
　　　'ACなのに無かった
　　　　h.copy
　　　　range("A1").insert shift:=xlshiftdown
　　　　buf = ""

　　　elseif buf = "BC" then
　　　’BCが無かった時は，ACの最後を探すことにする
　　　　buf = "AC"

　　　elseif buf = "CC" then
　　　　buf = "BC"

　　　elseif buf = "DC" then
　　　　buf = "CC"
　　　end if

　　else
　　’AC/BC/CC/DCがＡ列にあった
　　　h.copy
　　　target.offset(1).insert shift:=xlshiftdown
　　　buf = ""
　　end if
　loop

next
end sub

お礼

ありがとうございます！
これで実行してみたのですが「C1セル」「E1セル」「G1セル」「I1セル」に数値が入った場合、望みの結果ができました！
ただ、実際に組み込む場合この各セルには関数をいれています。
その場合、計算式も含めたセルがA列に挿入されます。これを値のみで挿入というのは可能なのでしょうか？

回答No.1

Prome_Lin

ちょっと、自信はありませんが、こういうことでしょうか？

Option Explicit
Sub Test()
Dim a(3), c As String
Dim i, j As Integer
a(0) = "C1"
a(1) = "E1"
a(2) = "G1"
a(3) = "I1"
For i = 0 To 3
c = Left(Range(a(i)).Value, 2)
For j = Range("A1").End(xlDown).Row To 1 Step -1
If c = Left(Cells(j, 1).Value, 2) Then
Rows(j + 1).Insert
Cells(j + 1, 1).Value = Range(a(i)).Value
Exit For
End If
Next
Next i
End Sub

結果は、こうなりました。
AC○
AC○
AC10
AC12
BC○
BC○
BC10
CC○
CC○
DC○
DC10

お礼

ありがとうございます！
これで実行してみたのですが仮にA列に「AC」のカテゴリデータがなかった場合に「AC10」「AC12」などのデータが反映されませんでした。
なかなか難しいですね(-_-;)