Ｐａｇｅ 588 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼文字列から配列変数を取得する方法 日高久雄 03/1/20(月) 12:33 ┣Re:文字列から配列変数を取得する方法 ichinose 03/1/20(月) 15:23 ┃ ┣訂正です ichinose 03/1/20(月) 15:55 ┃ ┗Re:文字列から配列変数を取得する方法 日高久雄 03/1/21(火) 13:13 ┃ ┗Re:文字列から配列変数を取得する方法 ichinose 03/1/21(火) 22:01 ┃ ┗夢でバグ発見しました・・・ ichinose 03/1/22(水) 2:15 ┃ ┗Re:夢でバグ発見しました・・・ 日高久雄 03/1/22(水) 13:22 ┗Re:文字列から配列変数を取得する方法 ポンタ 03/1/21(火) 9:14 ┗Re:文字列から配列変数を取得する方法 日高久雄 03/1/21(火) 13:18 ┗Re:文字列から配列変数を取得する方法 ポンタ 03/1/21(火) 13:30 ┗Re:文字列から配列変数を取得する方法 日高久雄 03/1/22(水) 13:27 ┗Re:文字列から配列変数を取得する方法 ポンタ 03/1/22(水) 17:37 ─────────────────────────────────────── ■題名 ： 文字列から配列変数を取得する方法 ■名前 ： 日高久雄 <hisao_hidaka@hotmail.com> ■日付 ： 03/1/20(月) 12:33 -------------------------------------------------------------------------
| 昨年下記の質問に keinさんから 次のような回答を頂き 大変助かったのですが ちょっとした問題に ぶつかり 配列がよく解らないので 困っています。マクロをどう変えればよいか教えてください。 全く別の方法でも結構です。宜しくお願い致します。 質問 range("A1")に "Aは(東京)です、Bは(大阪)です、Cは(名古屋)です。" と文字列があったとします。VBAを使って range("B1")に東京、range("C1")に大阪、range("D1")に名古屋と表示 更に range("A2")に "Aは(1)です、Bは(2)です、Cは(3)です。"と表示させる方法は無いでしょうか。 上記質問に次の方法をkeinさんから教えていただきました。 Sub Test_MySt2() Dim i As Integer, j As Integer, k As Integer Dim MyAr1() As Integer, MyAr2() As Integer Dim Buf As String, Buf2 As String Buf = Range("A1").Value Range("A2").Value = Buf For i = 1 To Len(Buf) If Mid(Buf, i, 1) = "(" Then ReDim Preserve MyAr1(j) MyAr1(j) = i + 1 j = j + 1 ElseIf Mid(Buf, i, 1) = ")" Then ReDim Preserve MyAr2(k) MyAr2(k) = i k = k + 1 End If Next i For i = LBound(MyAr1) To UBound(MyAr1) Buf2 = Mid(Buf, MyAr1(i), MyAr2(i) - MyAr1(i)) Range("IV1").End(xlToLeft).Offset(, 1).Value = Buf2 Range("A2").Replace Buf2, i + 1 Next i End Sub ところで このマクロだと 例えば "Aは(東京)です、Bは(大阪)です、Cは(名古屋)です、東京は晴天です" とありますと range("A2")の ( )に入っていない2度目の東京のところも "1は晴天です"と変換されます。 ( )内だけを 数字に変換したいのですが マクロをどのように 改変すれば宜しいでしょうか。どうか助けてください。 |
| ▼日高久雄 さん： こんにちは。色んな文字でテストしていませんが、ケインさんとは別ロジックです。 確認してみて下さい。 '=========================================== Sub test() Call moji_convert(Range("a1")) 'セルＡ１に「Aは(東京)です、Bは(大阪)です、Cは(名古屋)です、東京は晴天です」 'が入っているものとします End Sub '=========================================== Sub moji_convert(rng As Range) Dim idx As Long Dim jdx As Long Dim ques_str As String Dim ans() As String Dim cans() As String ques_str = rng.Value ans() = Split(ques_str, "(") jdx = 1 For idx = LBound(ans()) To UBound(ans()) cans = Split(ans(idx), ")") If UBound(cans()) - LBound(cans()) > 0 Then rng.Offset(0, idx).Value = cans(LBound(cans)) ques_str = Replace$(ques_str, "(" & cans(LBound(cans)) & ")", "(" & jdx & ")") jdx = jdx + 1 End If Erase cans Next rng.Offset(1, 0).Value = ques_str End Sub |
| ▼日高久雄 さん： 訂正です。 Sub moji_convert(rng As Range) Dim idx As Long Dim jdx As Long Dim ques_str As String Dim ans() As String Dim cans() As String ques_str = rng.Value ans() = Split(ques_str, "(") If UBound(ans()) - LBound(ans()) > 0 Then jdx = 1 For idx = LBound(ans()) To UBound(ans()) cans = Split(ans(idx), ")") If UBound(cans()) - LBound(cans()) > 0 Then rng.Offset(0, jdx).Value = cans(LBound(cans)) ques_str = Replace$(ques_str, "(" & cans(LBound(cans)) & ")", "(" & jdx & ")") jdx = jdx + 1 End If Erase cans Next rng.Offset(1, 0).Value = ques_str End If End Sub |
| ▼ichinose さん： 有難うございました。素晴らしいです。 ひとつ 教えてください、この後 訂正ソフトも頂きましたが、実行結果は同じでした。 どちらもOKでした。申し訳ないですが 勉強のため 1回目のソフトに どう言った不都合があったのでしょうか、お教えくだされば幸甚です。 それと こんな素晴らしいプログラムが組めるには 何か良い参考書はないでしょうか？ 基礎的な事はある程度解るのですが 特に配列がらみとなると ちょっとお手上げです。 >▼日高久雄 さん： >こんにちは。色んな文字でテストしていませんが、ケインさんとは別ロジックです。 >確認してみて下さい。 >'=========================================== >Sub test() > Call moji_convert(Range("a1")) >'セルＡ１に「Aは(東京)です、Bは(大阪)です、Cは(名古屋)です、東京は晴天です」 >'が入っているものとします >End Sub >'=========================================== >Sub moji_convert(rng As Range) > Dim idx As Long > Dim jdx As Long > Dim ques_str As String > Dim ans() As String > Dim cans() As String > ques_str = rng.Value > ans() = Split(ques_str, "(") > jdx = 1 > For idx = LBound(ans()) To UBound(ans()) > cans = Split(ans(idx), ")") > If UBound(cans()) - LBound(cans()) > 0 Then > rng.Offset(0, idx).Value = cans(LBound(cans)) > ques_str = Replace$(ques_str, "(" & cans(LBound(cans)) & ")", "(" & jdx & ")") > jdx = jdx + 1 > End If > Erase cans > Next > rng.Offset(1, 0).Value = ques_str >End Sub |
| ▼日高久雄 さん： こんばんは。 >この後 訂正ソフトも頂きましたが、実行結果は同じでした。 >どちらもOKでした。申し訳ないですが 勉強のため 1回目のソフトに どう言った不都合があったのでしょうか、お教えくだされば幸甚です。 「・・・(・・)・・・(・・・)・・」と対になった()が正しく記述されていれば、どっちでも動きますね。 >Sub moji_convert(rng As Range) > Dim idx As Long > Dim jdx As Long > Dim ques_str As String > Dim ans() As String > Dim cans() As String > ques_str = rng.Value > ans() = Split(ques_str, "(") If UBound(ans()) - LBound(ans()) > 0 Then 'このIF文で、「Aは東京)です」なんて文を弾いてます > jdx = 1 > For idx = LBound(ans()) To UBound(ans()) > cans = Split(ans(idx), ")") > If UBound(cans()) - LBound(cans()) > 0 Then rng.Offset(0, jdx).Value = cans(LBound(cans)) ' ここは、単なる記述ミスなんですが、 ' idxにしておくと、Lbound(ans())は、0から始まるんで ' 怖いでしょう？rng.offset(0,0)となっては・・・ ' ちゃんと()が対になってれば、起きないけど・・・ > ques_str = Replace$(ques_str, "(" & cans(LBound(cans)) & ")", "(" & jdx & ")") > jdx = jdx + 1 > End If > Erase cans > Next > rng.Offset(1, 0).Value = ques_str > End If >End Sub >それと こんな素晴らしいプログラムが組めるには 何か良い参考書はないでしょうか？ ははっ、ありがとうございます。お世辞でもうれしいです。 私なんかまだまだ^2 なんですが・・・・。 このサイトで投稿されているコードはできるかぎりチェック､チェックして・・・。 これはいつか使うときがありそう・・・と思うものは、はっきり言ってパクリます。 そして、インターフェースだけちょこっと変えて自分が後で使いたいときは、Callすればいいだけにしておいて、気が向いたら中身をトレースしています。 って、これ、全然、返事になってないですね。 こんなに難しい御質問、私には結局のところお答えできないんですが､ 「ここに投稿されているコードをたくさん読んで、又､自分でもたくさん作ってみる・・・」を私も現在進行形でやっとります。つまり、このサイトが参考書です。 久しぶりにアルコールが入っていない夜なのに（実は昨日も新年会で・・）、アルコールが入っているような文章になってしまいました。 |
| ▼日高久雄 さん： こんばんは。眠っていたら、夢でバグ発見したので・・・。 '========================================================= Sub moji_convert(rng As Range) Dim idx As Long Dim jdx As Long Dim ques_str As String Dim ans() As String Dim cans() As String ques_str = rng.Value ans() = Split(ques_str, "(") If UBound(ans()) - LBound(ans()) > 0 Then jdx = 1 For idx = LBound(ans()) + 1 To UBound(ans()) ' ↑２番目からチェックしないと、最初が「)(」ときの不具合 cans = Split(ans(idx), ")") If UBound(cans()) - LBound(cans()) > 0 Then rng.Offset(0, jdx).Value = cans(LBound(cans)) cans(LBound(cans)) = jdx ans(idx) = Join(cans(), ")") ' 上２行は、()の中が全部「東京」だったとき、(1)・・(1)になってしまう jdx = jdx + 1 End If Erase cans Next End If rng.Offset(1, 0).Value = Join(ans(), "(") End Sub やっぱり、まだまだです。 |
| 本当に助かりました。有難うございます。 今後も宜しくお願い致します。 ▼ichinose さん： >▼日高久雄 さん： >こんばんは。眠っていたら、夢でバグ発見したので・・・。 >'========================================================= >Sub moji_convert(rng As Range) > Dim idx As Long > Dim jdx As Long > Dim ques_str As String > Dim ans() As String > Dim cans() As String > ques_str = rng.Value > ans() = Split(ques_str, "(") > If UBound(ans()) - LBound(ans()) > 0 Then > jdx = 1 > For idx = LBound(ans()) + 1 To UBound(ans()) > ' ↑２番目からチェックしないと、最初が「)(」ときの不具合 > cans = Split(ans(idx), ")") > If UBound(cans()) - LBound(cans()) > 0 Then > rng.Offset(0, jdx).Value = cans(LBound(cans)) > cans(LBound(cans)) = jdx > ans(idx) = Join(cans(), ")") >' 上２行は、()の中が全部「東京」だったとき、(1)・・(1)になってしまう > jdx = jdx + 1 > End If > Erase cans > Next > End If > rng.Offset(1, 0).Value = Join(ans(), "(") >End Sub > >やっぱり、まだまだです。 |
| 勉強がてら、正規表現を使ってやってみました。 Sub test() Dim objRE As Object, Matches As Object, Match As Object, objDic As Object Dim i As Integer, MyString As String Set objDic = CreateObject("Scripting.Dictionary") Set objRE = CreateObject("VBScript.RegExp") objRE.Pattern = "\([^\)]+\)" objRE.Global = True MyString = Range("A1").Value Set Matches = objRE.Execute(MyString) i = 1 For Each Match In Matches If objDic.exists(Match.Value) = False Then objDic.Add Match.Value, "(" & i & ")" i = i + 1 End If Next For Each Match In Matches objRE.Pattern = "\(" & Match.Value & "\)" MyString = objRE.Replace(MyString, objDic(Match.Value)) Next Range("B1").Value = MyString End Sub |
| ▼ポンタ さん： 有難うございました。( )の中身を range("B1:D1")に 抽出したかったのですが。 >勉強がてら、正規表現を使ってやってみました。 > >Sub test() > Dim objRE As Object, Matches As Object, Match As Object, objDic As Object > Dim i As Integer, MyString As String > Set objDic = CreateObject("Scripting.Dictionary") > Set objRE = CreateObject("VBScript.RegExp") > objRE.Pattern = "\([^\)]+\)" > objRE.Global = True > MyString = Range("A1").Value > Set Matches = objRE.Execute(MyString) > i = 1 > For Each Match In Matches > If objDic.exists(Match.Value) = False Then > objDic.Add Match.Value, "(" & i & ")" > i = i + 1 > End If > Next > For Each Match In Matches > objRE.Pattern = "\(" & Match.Value & "\)" > MyString = objRE.Replace(MyString, objDic(Match.Value)) > Next > Range("B1").Value = MyString >End Sub |
| 忘れてました。(汗 Sub test() Dim objRE As Object, Matches As Object, Match As Object, objDic As Object Dim i As Integer, MyString As String Range("B1:IV1").ClearContents Set objDic = CreateObject("Scripting.Dictionary") Set objRE = CreateObject("VBScript.RegExp") objRE.Pattern = "\([^\)]+\)" objRE.Global = True MyString = Range("A1").Value Set Matches = objRE.Execute(MyString) i = 1 For Each Match In Matches If objDic.exists(Match.Value) = False Then Range("IV1").End(xlToLeft).Offset(0, 1).Value = Mid(Match.Value, 2, Len(Match.Value) - 2) objDic.Add Match.Value, "(" & i & ")" i = i + 1 End If Next For Each Match In Matches objRE.Pattern = "\(" & Match.Value & "\)" MyString = objRE.Replace(MyString, objDic(Match.Value)) Next Range("A2").Value = MyString End Sub |
| 有難うございました。本当に助かりました。 どうしたら こんなプログラムが組めるようになるのでしょうか。 基礎はちょっとかじっているのですが 何か良い参考書でもあれば 教えてください。 ▼ポンタ さん： >忘れてました。(汗 > >Sub test() > Dim objRE As Object, Matches As Object, Match As Object, objDic As Object > Dim i As Integer, MyString As String > Range("B1:IV1").ClearContents > Set objDic = CreateObject("Scripting.Dictionary") > Set objRE = CreateObject("VBScript.RegExp") > objRE.Pattern = "\([^\)]+\)" > objRE.Global = True > MyString = Range("A1").Value > Set Matches = objRE.Execute(MyString) > i = 1 > For Each Match In Matches > If objDic.exists(Match.Value) = False Then > Range("IV1").End(xlToLeft).Offset(0, 1).Value = Mid(Match.Value, 2, Len(Match.Value) - 2) > objDic.Add Match.Value, "(" & i & ")" > i = i + 1 > End If > Next > For Each Match In Matches > objRE.Pattern = "\(" & Match.Value & "\)" > MyString = objRE.Replace(MyString, objDic(Match.Value)) > Next > Range("A2").Value = MyString >End Sub |
| 今回使った"正規表現"はVBScriptの機能なので、 どちらかというと応用の範疇だと思います。 |