vba MID関数を用いて複数回"、"の間の文字を抜き出す

vbaで、1つの変数(以下では変数Original)に
B社、CC社、DDD社、EE社、FABC社
という文字列*が入っている時、"、"を使って、各文字を、以下のように分割したいです。

字数は不規則、文字列は全て"、"で区切られていること以外規則性はなし、各文字列は上記では5つですが、実際はいくつ入っているかわかりません。

A1セル:B社
A2セル:CC社
A3セル:DDD社
A4セル:EE社
A5セル:FABC社

◆現状
"、"の数をカウントし、"、"がcnt個あることがわかり、会社数はcnt+1個あるとわかりました。

◆不明点
分からないのは、Mid関数を使い、i番目の会社の文字列を特定し、抜き出す部分です。
特に、i番目の会社の文字列の開始位置をどのように指定し、プログラムを組むか、というところです。
具体的には、

1番目の会社は1,
2番目の会社は=InStr(Original,Kigou)+1
となるので、
i番目の会社は、

i番目の会社は、
=InStr(InStr(InStr...Instr(Original,Kigou)+1),Original,Kigou)+1),...,Original,Kigou)+1)

この式を自動的に作成するため、
2番目の会社の式の前に、
文字列"InStr("を(i-1)回足し、
2番目の会社の式の後に",Original,Kigou)+1)をi-2回足せばi番目の式になり、それが計算できれば良いと思っているのですが、生成した文字がStringのせいか、何のせいか、計算されません。
急いでいて間違えているかもしれません。
ご教示下さい。
どうぞよろしくお願い致します。

Sub Macro1()
Dim Original As String, Kigou As String
Original = "B社、CC社、DDD社、EE社、FABC社"
Kigou = "、"

Dim FirstCompanyName As String, ithCompanyName As String, LastCompanyName As String
FirstCompanyName = Left(Original, InStr(Original, Kigou) - 1)
'i番目の会社の名前を順番に取得
'Mid関数＝Mid(検索対象文字列, 抜き出す文字列の開始位置（数字） [,抜き出す文
字列の長さ（数字）])
'抜き出す文字列の開始位置（数字）：i番目の会社の場合、i-1番目の"、"の次の文
字の序数
'抜き出す文字列の長さ（数字）：i番目の会社の場合、「i+1番目の"、"の前の文字
の序数」-「i番目の会社の場合、i-1番目の"、"の次の文字の序数」
Dim i As Variant 'i番目の会社
Set i = 0
Dim N As Long, cnt As Long
N = InStr(1, Original, Kigou)
Do While N > 0
cnt = cnt + 1
N = InStr(N + 1, Original, Kigou)
Loop

    Dim CompanyNum As Long
    CompanyNum = cnt + 1

'抜き出す文字列の開始位置（数字）=iStart
Dim iStart As Variant
'(InStrを（i-1）回生成する変数xを作成
x = WorksheetFunction.Rept("InSTr(", i - 1)
y = WorksheetFunction.Rept(",Original,Kigou)+1", i - 2)
iStart = Left(InStr(-1,Original,Kigou)
For i = 0 To CompanyNum

ithCompanyName = Mid(Original, x +(InStr(Original, Kigou) + 1), Len(InStr(i
+1,Original,Kigou))
LastCompanyName = Mid(Original, InStrRev(Original, Kigou) + 1)

End Sub

ttyp03

2020/01/31 07:16

Split関数で済みそうな話ですが、Mid関数に拘っている理由はなんですか？あと結局のところやりたいことは、文字列を分解して、それをA列に並べたいということでしょうか？

Mai0429

2020/01/31 16:12

こちらのご質問もありがとうございました。今までいただいたご回答を他の自分のパートと組み合わせてできるかどうか試していてお返事がが遅くなってしまいました。申し訳ございません。回答を拝見し、Split関数の方が断然速く済むと理解しました。初心者なのでSplit関数の配列云々はよくわかっておらず今回勉強しながら少し理解しました。 Mid関数は、「検索対象文字列から特定の文字だけを取り出す　関数」などと検索して出てきたのがほとんどLeft, Mid, Right, Find, InStr等だったので組み合わせようとしていただけでした。配列をよくわかっていなかったため、セルへの出力方法もわかっておらず、出力方法まで書いて下さったttyp03さんをベストアンサーにさせていただきました。非常に助かりました。

行動規範の内容に同意します

回答3件

結果が不特定多数になる場合は配列変数を使うといいです。

ExcelVBA
1Sub Macro1()
2    Const Original As String = "B社、CC社、DDD社、EE社、FABC社"
3    Const Kigou As String = "、"
4    Dim i As Long, j As Long, n As Long
5    Dim sNames() As String
6    ReDim sNames(1 To 100)
7    
8    i = 1
9    j = InStr(i, Original, Kigou)
10    Do Until j = 0
11        n = n + 1
12        sNames(n) = Mid(Original, i, j - i)
13        i = j + 1
14        j = InStr(i, Original, Kigou)
15    Loop
16    
17    ReDim Preserve sNames(1 To n)
18    
19    Range("A1").Resize(n).Value = WorksheetFunction.Transpose(sNames)
20End Sub

※今回の件の場合はSplit関数を使うとその部分を自作する必要がないです。

投稿2020/01/31 08:00

mattuwan

総合スコア2167

Mai0429

2020/01/31 16:07

MidとInStrを使った書き方をご教示下さり、誠にありがとうございます。今回は確かにsplitの方が圧倒的に簡潔にできるようですが、今後こちらのコードを別の機会に参考にさせていただくこともあると思います。そして、MidとStrの場合はこんなふうに書くんだ！と納得できました。どうもありがとうございました。m(_ _)m

mattuwan

2020/01/31 22:42

そうですね。プログラミングの初歩としてはいい例題かもです。次はTranspose関数を自作してみるとかいいかもですね。興味があれば。。。

Mai0429

2020/02/01 02:51

難しいですが大変勉強になりました。はい、時間ができたら考えてみます。(oﾟｪﾟo)ﾉ

行動規範の内容に同意します

ベストアンサー

先走って回答します。
要件としては、

"、"を使って、各文字を、以下のように分割したいです。

と思われるので、Split関数で分割して丸ごと貼り付けるサンプルです。

VBA
1Sub Macro1()
2    Dim Original As String, Kigou As String
3    Dim words() As String
4    Original = "B社、CC社、DDD社、EE社、FABC社"
5    Kigou = "、"
6
7    words = Split(Original, Kigou)
8    Range("A1:A" & UBound(words) + 1).Value = Application.WorksheetFunction.Transpose(words)
9End Sub
10

投稿2020/01/31 07:51

ttyp03

総合スコア17000

Mai0429

2020/01/31 16:10

ご回答ありがとうございました。 split関数を用いて簡略化した式 +セルに入力するところまで書いてくださったことで、無事ひな形ができました。一番簡単にゴールまで導いて下さったので、ベストアンサーとさせていただきました。m(_ _)m

行動規範の内容に同意します

split関数を使った例です。

VBA
1Sub Macro1()
2    Dim Original As String, Kigou As String
3    Original = "B社、CC社、DDD社、EE社、FABC社"
4    Kigou = "、"
5    Dim campanies() As String
6    campanies = Split(Original, Kigou)
7    Dim i As Long
8    For i = 0 To UBound(campanies)
9        Debug.Print campanies(i)
10    Next
11End Sub
12