ＡＬＴ＋Ｆ１１を押す
前のマクロを全て消去する
改めて下記をコピー貼り付ける
public function CONCATENATECOUNT(Target as excel.range) as string
dim h as range
dim myDic as object
dim o as variant
dim n as long
dim s as string
dim p as long
dim res as string
set mydic = createobject("Scripting.Dictionary")
for each h in target
if h <> "" then
s = h.value
for p = len(s) to 1 step -1
if not strconv(mid(s, p, 1), vbnarrow) like "[0-9]" then exit for
next p
n = iif(p = len(s), 1, mid(s, p + 1))
s = iif(p = 0, "#", left(s, p))
mydic(s) = mydic(s) + n
end if
next
for each o in mydic.keys
res = res & "," & o & iif(mydic(o) > 1, mydic(o), "")
next
concatenatecount = mid(res, 2)
end function
結合セルに
=CONCATENATECOUNT(A1:F1)
のように記入する。
＃補足
後ろに数字がついていたら個数とします。
「りんご１０」なら構いませんが、もし「りんご０」と記入されていた時はりんごがゼロ個という意味になるので数として数えません。
＃補足やお礼の中で追加で別のご相談を寄せられても（実は実はとダラダラ終わらないご相談が多くて）おつきあいするつもりはありませんので、前のご相談が閉じられていたのはまぁ怪我の功名とでも言いますか。状況が違った、ヤリタイ事がもうちょっとこういう具合に変わったというときは、ヤリタイ事をキチンと整理して、新しいご相談として改めて投稿なさってください。
前のご質問に絡めて次のご相談を投稿するときは、「このご相談投稿から見た人」にもちゃんと意味が通じるように、必要な説明を手抜きせずに書き添えるようになさってください。
前回ご質問のＵＲＬを明記したうえで、今回はここがこうなっててこうしたいと書いていただくのでも、まぁＯＫです。
お礼
たいへんありがとうございました。 おっしゃっていただいたご指摘，ごもっともです。 以後，気を付けます。 また機会がありましたら，どうぞよろしくお願いいたします。