vbaで、配列の各要素GroupNum(n)に対し、特定の文字を取り出し、シートに表示したいですが、以下のコードでは
NGroup(n)について、「SubまたはFunctionがありません」とエラーが出てしまいます。
エラーを解消するか、もしくは下記の最終目的を達成する他の方法はありますか?
(またコトを複雑にしているかもしれないので簡単な方法があればご教示ください。)
以前の質問にいただいた回答を利用して途中まで作成してみたのですが、
その後最終目的を達成するまでどうすれば良いか、わかりません。
色々試したもののうまくいかず、かなり時間がかかってしまったため、質問させてください。
A1セルの内容:
①あいう/Aかきく
②さしすせ/Aかきく、けこ
③なにぬね/Aかきく、たちつてと、はひふへ
④たち/Aかきく、あかさたな
⑤はひふへほ/Aかきく、さしすせそ
⑥やゆよ/Aなにぬ
⑦わを/Aあかさたなはまやらわ
↑それぞれの行で改行してあります。
<最終的目的>
上記A1セルの内容を、分割し、それぞれ別の変数?配列?に入れ、下記のようにシートに出力したいです。
①あいう/(A)かきく 部分
→
B1:あいう
B2:かきく
②さしすせ/(A)かきく、けこ 部分
→
B3:さしすせ
B4:かきく
B5:けこ
...
③〜⑦も同様
また、A1以外の他のセル(A2,A3...)には⑦までない場合もありますが、適宜可変となるようにしたいです。
Sub Macro1() Dim Origin As String = ThisWorksheet.Range("A1").Value If InStr(Origin,"⑦")> 0 Then GroupNum = 7 ElseIf InStr(Origin, "⑥")>0 Then GroupNum = 6 ElseIf InStr(Origin, "⑤")>0 Then GroupNum = 5 ElseIf InStr(Origin, "④")>0 Then GroupNum = 4 ElseIf InStr(Origin, "③")>0 Then GroupNum = 3 ElseIf InStr(Origin, "②")>0 Then GroupNum = 2 ElseIf InStr(Origin, "①")>0 Then GroupNum = 1 Else GroupNum = 0 End If Dim i As Long, j As Long, n As Long Dim NGroups() As String ReDim NGroups(1 To GroupNum) i = 1 j = InStr(i, Origin, vbLf) Do Until j = 0 n = n + 1 NGroups(n) = Mid(Origin, i, j - i) i = j + 1 j = InStr(i, Origin, vbLf) Loop ReDim Preserve NGroups(1 To n) 'セルA1中、最後の行である⑦はNGroupsに入っていないので追加。 NGroups(GroupNum) =Mid(Origin, (InStrRev(Origin, vbLf) + 1)) '以上でNGroups(n)にA1セル内各行を分割し挿入済 '以下では各要素に対し、特定の文字を抜き出したい Dim First() As String, Second() As String For n = 1 To GroupNum First = Mid(NGroups(n), 2, InStr(NGroups(n), "/A") -2) Second = Mid(NGroups(n), (InStr(NGroups(n), "/A")+ 2)) Dim w() As String w = Split(Second, "、") Dim q As Integer For q = 0 To UBound(w) '↓以下だと表示順序がA1セルと異なってしまうので何か良い方法はないか? ThisWorksheet.Range("A" & n + 1).Value = First(n) ThisWorksheet.Range("A" & n + GroupNum + q + 1).Value = WorksheetFunction.Transpose(w(q)) Next End Sub
<現状>
上記のコードを実行した結果、エラーが出る部分のコードを除き実行すると、
GroupNum(1) = ①あいう/(A)かきく
GroupNum(2) = ②さしすせ/(A)かきく
...
GroupNum(7) = ⑦わを/(A)あかさたなはまやらわ
が入っている形です。
どうぞよろしくお願いいたします。
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2020/02/06 03:55