Results of 1 - 1 of about 48835 for A�����������������������... (0.010 sec.)
- [[20090722151922]]
- #score: 1420
- @digest: 0254d7d09324c23309610c3a5be59372
- @id: 44625
- @mdate: 2009-08-27T23:22:02Z
- @size: 22503
- @type: text/plain
- #keywords: mymatch (144041), c14h14o3n3na (84670), 物質 (78353), 坊) (61275), chem (58145), strsplit (38266), 困困 (36889), 学式 (34021), 化学 (27541), xlerrna (26695), pattern (20012), execute (13451), ゅん (6515), じゅ (6376), isempty (6298), global (6002), 分解 (5541), vbscript (5332), seiya (5181), flg (5176), regexp (4565), function (4141), txt (3913), ubound (2583), variant (2167), createobject (1881), ロシ (1709), ・・ (1656), boolean (1654), 一致 (1583), 修正 (1553), test (1506)
- 『アルファベットの後の数字を取り出す』（困困）
以前、困っているところ助けていただきありがとうございます。 化学式で元素（C,H,N,S,Na等）の後の数値を取り出すマクロをご教授願います。 なお、数値は半角で下付き文字にはしていません。 例1 A B C 1 C5H11O2N c 5 2 H 11 3 O 2 4 N 1 例2 A B C 1 C14H14O3N3Na c 14 2 H 14 3 O 3 4 N 3 5 Na 1 B列の並びは何時も同じ並びではありません。 よろしくお願いします。 ---- これで試してください。 UDFです 1) Alt + F11 でVBEを起動 2) [挿入] - [標準モジュール], 右空白部分に下記コードを貼り付ける 3) Alt + F11 でエクセル画面に戻る セルに =ChemicalSign($A$1,Column(A1),Row(A1)) として、右/下にコピー Function ChemicalSign(ByVal txt As String, ByVal Ind As Long, ByVal ref As Long) ChemicalSign = 0 With CreateObject("VBScript.RegExp") .Pattern = "([A-Z][a-z]?)(¥d+)?" .Global = True If .test(txt) Then ChemicalSign = .execute(txt).item(Ind - 1).submatches(ref - 1) End If End With End Function (seiya) ---- （困困） seiya様 確認遅くなりすみません。 行に回答が出来るんですね。 良かったら、コードの意味、下記部分について教えていただけないでしょうか。 .Pattern = "([A-Z][a-z]?)(¥d+)?" .Global = True If .test(txt) Then ChemicalSign = .execute(txt).item(Ind - 1).submatches(ref - 1) ---- 「正規表現」(Regular Expression)を調べてください。 (seiya) ---- seiya様 「正規表現」(Regular Expression)・・・・こんなオブジェクトがあるとは・・・・ 勉強になります。 RegExpオブジェクトを使って、物質検索マクロを作成したいです。 また、解らないことがあれば、ご教授願います。 (困困) ---- 困困様、seiya様 VBAを始めたばかりの「Chem坊」といいます。 困困様、その後化学物質の検索マクロは完成されたのでしょうか。その後、スレが出れば 私も、一緒に勉強させていただくつもりでしたが、出ないので皆さんにご教示していただきたく 便乗させていただきました。 他のsheet「一覧表」のB列4行目以降に化学式があります。（ただし、アルファベットは必ずしも順に並んでいない） 検索シートから、順に「C14」、「H14」、「O3」、「N3」、「Na」と検索して、一致した化学式を取り出したいです。 他にも、良い方法がありましたらよろしくお願いいたします。 (Chem坊) ---- 困困様、seiya様 記述不足の箇所がありました。 >他のsheet「一覧表」のB列4行目以降に化学式があります。（ただし、アルファベットは必ずしも順に並んでいない） >検索シートから、順に「C14」、「H14」、「O3」、「N3」、「Na」と検索して、一致した化学式を取り出したいです。 上記は困困さんの、例2をとりあげて質問させていただきました。 また、スレでなくレスだったんですね。スレだと理解してました。（汗） きおつけ〜!礼! それではよろしくお願いします。 (Chem坊) ---- Chem坊さんの求めている結果を取り違えていたらごめんなさい。 Sub try() Dim myReg As Object Dim st As String, ss As String Dim v As Variant Set myReg = CreateObject("VBScript.RegExp") myReg.Pattern = "([A-Z][a-z]*¥d+|[A-Z][a-z]*)" myReg.Global = True st = "C14H14O3N3Na" If myReg.Test(st) Then For Each v In myReg.Execute(st) ss = ss & vbLf & v Next End If MsgBox st & vbLf & ss Set myReg = Nothing End Sub こんな感じの事をしたいのかなって思いましたが、どのようなデータから どのような結果を返したいのかを、明確にされた方が宜しいかも知れません。 （じゅんじゅん） ---- （じゅんじゅん） どうも、説明が上手く出来ずすみません。 こんな感じです。 Sheet(1)のA1に化学式を入力して、分解した値をB1以降に抽出もしくは保持する。 Sheet(2)のA列の物質名から検索、検索されたセルをアクティブにする。 (ただし、並びの異なる場合も同じとして検出する） Sheet(1) A B C D E F 1 C14H14O3N3Na C14 H14 O3 N3 Na Sheet（2） A B C D E F 1 化学式 2 C6H10O3 3 C8H11NO 4 C14H14N3O3Na ←このような並びの異なる場合も同じとして検出 5 C2Cl4 6 C2HBrF 7 C4H5NO2 8 C9H20O3 9 C2H5ON 10 ・・・・・・・ 11 ・・・・・・・ まだまだ、説明が不足しているかもしれませんが、よろしくお願いします。 (Chem坊） ---- 1) B1 から 抽出セル数を選択 2) =myMatch(A1,Sheet2!A1:A100) として、Ctrl + Shift + Enter で確定 (配列数式) で試してください。 Function myMatch(ByVal txt As String, rng As Range) As Variant Dim a, b(), i As Long, m As Object, flg As Boolean a = rng.Columns(1).Value With CreateObject("VBScript.RegExp") .Pattern = "^([A-Z][a-z]?¥d+?)+$" .Global = True For i = 1 To UBound(a, 1) If .test(txt) Then For Each m In .execute(txt) .Pattern = m.Value If Not .test(m.Value) Then Exit For : flg = True End If Next If Not flg Then myMatch = i Exit For End If End If flg = False Next If Not IsEmpty(myMatch) Then txt = a(i, 1) .Pattern = "[A-Z][a-z]?¥d+?" Set m = .execute(txt) ReDim b(m.Count - 1) For i = 0 To m.Count - 1 b(i) = m.item(i) Next End If End With myMatch = IIf(IsEmpty(myMatch), CVErr(xlErrNA), b) End Function (seiya) '署名追加 ---- (じゅんじゅん）さん 先程は、大変ご無礼をしました。（じゅんじゅん）と呼び捨てにしておりました。 今回のFunction プロシージャー、少し教えていただきたいのですがよろしいでしょうか。 1) B1 から 抽出セル数を選択 ← 理解力なくすみませんが、どんな意味でしょうか 2) =myMatch(A1,Sheet2!A1:A100) ← Sheet1の B1へ入力するのですよ ね。 として、Ctrl + Shift + Enter で確定 (配列数式) B1セルから下へ2）の式を配列変数で入力していますが、「#N/A」になります。 functionプロシージャで作成されたコードの検証は、どのような方法で出来るのでしょうか? また、SUBプロシージャで作成すると、どのようになるのでしょうか。? 沢山の質問ばかりですみませんが、よろしくお願いいたします。 （Chem坊） ---- > 1) B1 から 抽出セル数を選択 ← 理解力なくすみませんが、どんな意味でしょうか B1からF1（若しくは、抽出されるべきセル数)という意味です。 (seiya) ---- >また、SUBプロシージャで作成すると、どのようになるのでしょうか。? とりあえず、上記で機能するか試してからにしてください。 (seiya) ---- seiya様 回答していただいていたのは、seiya様だったんですね。 ありがとうございます。じゅんじゅんさん感謝です。 先日、質問してから出張がありまして、今朝拝見したところです。 (返事遅くなり、申し訳リません） seiya様、確認ですがご指導どうりsheet1のB1〜F1（この例の場合）配列数式を入力しましたが、「#N/A」が表示されます。 Functionプロシージャのデバッグ方法をご教示ねがえれば助かります。（調べたのですが分かりません） また、検索してヒットしたセルをアクティブにするのは、今後と言うことでしょうか? よろしくお願いします。 (Chem坊) ---- Function のDebug の方法は まず、Break Point を設定します。 コード中の a = rng.Columns(1).Value の左側のProject Explorer と Code pane の境界をクリックすると ●(黒ではありませんが)ができます。 もし、上記がわからなければ a = rng.Columns(1).Value Stop '<- 挿入 してください。 シートに戻って、もう一度範囲を選択して数式バーをクリックして Ctrl + Shift + Enter で確定すると、Break Point を設定した行でDebug mode になります。 (seiya) ---- seiya様 Debug方法を教えていただきありがとうございます。 早速、Debag行いました。 これまで方法も分からなかったのに、Debugできてうれしいです。 結果:myMatchにエラー「2042」が出ます。 Sheet2のA4の「C14H14N3O3Na」を「C14H14O3N3Na」へ変更してみましたが、結果は同じです。 ちなみに、mはNothingでした。 seiya様 よろしくお願いします。 (Chem坊) ---- そうでしたか、 その前に C2HBrF はどのように分解するのでしょう? (seiya) ---- seiya様 C2HBrFの分解の件ですが、B1:C2, C1:H, D1:Br, E1:F このようになります。 数字がない場合は、H*1=H のようにです。（C2HBrF→C2H1Br1F1のように解釈できます） (Chem坊) ---- これでどうでしょう? MsgBox を仕掛けましたので、読んでいただけますか? それと"様" は止しましょう。 Function myMatch(ByVal txt As String, rng As Range) As Variant Dim a, b(), i As Long, m As Object, flg As Boolean a = rng.Columns(1).Value With CreateObject("VBScript.RegExp") .Pattern = "^([A-Z][a-z]?¥d+?)+$" .Global = True MsgBox "Pattern: ^([A-Z][a-z]?¥d+?)+$" & vbLf & .test(txt) For i = 1 To UBound(a, 1) If .test(txt) Then For Each m In .execute(txt) .Pattern = m.Value If Not .test(m.Value) Then Exit For : flg = True End If Next If Not flg Then myMatch = i Exit For End If End If flg = False Next If Not IsEmpty(myMatch) Then txt = a(i, 1) .Pattern = "[A-Z][a-z]?¥d+?" Set m = .execute(txt) ReDim b(m.Count - 1) For i = 0 To m.Count - 1 b(i) = m.item(i) Next End If End With myMatch = IIf(IsEmpty(myMatch), CVErr(xlErrNA), b) End Function (seiya) ---- seiyaさん >"様" は止しましょう。・・・・以後、”seiyaさん”で行かせていただきます。 >MsgBox を仕掛けましたので、読んでいただけますか? MsgBox内容見ますが、”False”になっています。 その他の、コードは変更なしなのですね。 (Chem坊) ---- > MsgBox内容見ますが、”False”になっています .Pattern = "^([A-Z][a-z]?¥d+?)+$" がヒットしていないようですね... .Pattern = "([A-Z][a-z]?¥d+?)" にして試していただけますか? (seiya) ---- 横から失礼します。 seiyaさんへ >.Pattern = "([A-Z][a-z]?¥d+?)" の場合ですと、 C14 → C1 Na → 該当しない となるようです。 ”数字が1個以上ある事”で成立し、且つ”数字は1個だけ”選ばれる感じです。 ⇒ただ私が試していたコードでの検証です。 そのコードでヒット出来たパターンは myReg.Pattern = "([A-Z][a-z]?)(¥d+)?" でした。 （じゅんじゅん） ---- じゅんじゅんさん、ありがとうございます。 そうですか。 Chem坊さん .Pattern = "([A-Z][a-z]?)(¥d+)?" で試してください。 でも私には .Pattern = "([A-Z][a-z]?¥d+?)" .Pattern = "([A-Z][a-z]?)(¥d+)?" の違いがわからないのですが... (seiya) ---- >の違いがわからないのですが... 私も自信はありません・・・ ただ数字部分が”1個以上の集まりが、0回又は1回”と言う感じになるのかなって 思っているくらいですが、正直"?"の使い方ってまだわかってません。 （じゅんじゅん） ---- > ただ数字部分が”1個以上の集まりが、0回又は1回”と言う感じになるのかなって あっ、そうです! ありがとうございます。 (seiya) ---- seiyaさん、じゅんじゅんさん 衝突しちゃったようです。 >.Pattern = "([A-Z][a-z]?)(¥d+)?" で試してください。 早速試してみました。じゅんじゅんさんの言われるパターンでやってみました。 すこし、躓きましたがMsgはTrueが返りました。(躓き:Exit For、Next・・・・必要とは思いますが?） 動作状況は、以下のコードに書き入れています。 今度は、Sheet1のB1セル以下が「#VALUE!」になりました。 Function myMatch(ByVal txt As String, rng As Range) As Variant Dim a, b(), i As Long, m As Object, flg As Boolean a = rng.Columns(1).Value With CreateObject("VBScript.RegExp") '.Pattern = "^([A-Z][a-z]?¥d+?)+$" .Pattern = "([A-Z][a-z]?)(¥d+)?" .Global = True 'MsgBox "Pattern: ^([A-Z][a-z]?¥d+?)+$" & vbLf & .Test(txt) MsgBox "Pattern: ^([A-Z][a-z]?)(¥d+)?" & vbLf & .Test(txt) If .Test(txt) Then For Each m In .Execute(txt) .Pattern = m.Value If Not .Test(m.Value) Then Exit For: flg = True End If Next If Not flg Then myMatch = i 'Exit For ←"For Next内に対応するExit Forがありません”て出るので外しました。 End If End If flg = False 'Next ←Exit Forを外したところ"Nextに対応するForがありません"と出るので外しました。 If Not IsEmpty(myMatch) Then txt = a(i, 1) ・・・・・←このコードを過ぎると、一気に終了する。 .Pattern = "[A-Z][a-z]?¥d+?" '.Pattern = "([A-Z][a-z]?)(¥d+)?" Set m = .Execute(txt) ReDim b(m.Count - 1) For i = 0 To m.Count - 1 b(i) = m.Item(i) Next End If End With myMatch = IIf(IsEmpty(myMatch), CVErr(xlErrNA), b) End Function seiyaさん、じゅんじゅんさん、 よろしくお願いします。 (Chem坊) ---- ひっちゃかめっちゃかになっていましたね... すみません これで試してください。 Function myMatch(ByVal txt As String, rng As Range) As Variant Dim a, b(), i As Long, m As Object, flg As Boolean a = rng.Columns(1).Value With CreateObject("VBScript.RegExp") .Pattern = "([A-Z][a-z]?)(¥d+)?" .Global = True If .Test(txt) Then For i = 1 To UBound(a, 1) '<- 修正 17:10 For Each m In .Execute(txt) .Pattern = m.Value If Not .Test(a(i, 1)) Then flg = True : Exit For '<- 修正 16:34 End If Next If Not flg Then myMatch = i : Exit For End If flg = False Next If Not IsEmpty(myMatch) Then .Pattern = "([A-Z][a-z]?)(¥d+)?" Set m = .execute(a(i, 1)) ReDim b(m.count - 1) For i = 0 To m.count - 1 b(i) = m.item(i) Next End If End If End With myMatch = IIf(IsEmpty(myMatch), CVErr(xlErrNA), b) End Function ---- 全体は見てないのですが一点だけ気になったので ここの For Each m In .Execute(txt) .Pattern = m.Value If Not .Test(m.Value) Then Exit For: flg = True End If Next の、 Exit For: flg = True で、flg = True は通らないけれど良いのかな?と。 （ご近所PG）思った ---- ご近所PGさん ありがとうございます。 修正しました。 (seiya) ---- >For i = 1 To UBound(a(, 1)) For i = 1 To UBound(a, 1) でしょうか。 こちらでは C14H14O3N3Na ⇒ C14 H14 N3 O3 Na と結果がでました。 ご報告まで。 （じゅんじゅん） ---- またまた、ありがとうございます。 コード修正しておきます。 (seiya) ---- seiyaさん、じゅんじゅんさん、そしてご近所PGさん 皆さんお世話になります。 またまた、衝突しちゃったようです。 きちんと対応する物質が出せました。 ありがとうございます。 ただし、私の作成した例が悪くて申し訳ないのですが、Sheet2のA列にはC14H・・・・という物質が沢山あって、その中から該当する物質を抽出する必要があります。 下記にSheet2のA列の例を再掲します。 (再掲） Sheet(1) A B C D E F 1 C14H14O3N3Na C14 H14 O3 N3 Na Sheet（2） A B C D E F 1 化学式 2 C6H10O3 3 C8H11NO 4 C14H18N2O2 ←最初C14で候補には上がる。 5 C2Cl4 6 C2HBrF 7 C14H8N4O5F3 8 C9H20O3 9 C2H5ON 10 C14H14N3O3Na ←このような並びの異なる場合も同じとして検出 11 C4H4Cl2 こんな感じで、多くの物質があります。（上記例はむちゃくちゃですが・・・・） それにしても皆さんの、直ぐの対応感服するばかりです。 (Chem坊） ---- えーーと、よく意味がわからないのですが... 10 C14H14N3O3Na とマッチするのを確認して、 1 C14H14O3N3Na を分解するのではないのですか? 現在のコードでは 10 C14H14N3O3Na を分解してしまっていますが... > Set m = .execute(a(i, 1)) を Set m = .execute(txt) に変更すれば 1 C14H14O3N3Na の方を分解します。 (seiya) ---- seiyaさん 説明が不足しても仕分けありません。 検索で並びの異なるSheet1のA1と、Sheet2のA10が一致することを確認して Sheet2のA10をアクティブにしたいのです。 そのためには、Sheet1のA1を分解して、C14→H14→・・・・というように、 C14に該当する物質を全て取り出して、 取り出した物質をH14で一致するものを 抜出し、さらに抜出した物質からN3を有する物質を取り出して、 最終的には並びは違ってもそれぞれのアルファベットの後ろの数字がおなじであれば、 同物質として抽出したいのです。 (Chem坊) ---- ということは、 1 C14H14O3N3Na とSheet2 のA列の各分子?がすべて一致する行番号(10)を知りたい ということですか? Function myMatch(ByVal txt As String, rng As Range) As Variant Dim a, b(), i As Long, m As Object, flg As Boolean a = rng.Columns(1).Value With CreateObject("VBScript.RegExp") .Pattern = "([A-Z][a-z]?)(¥d+)?" .Global = True If .Test(txt) Then For i = 1 To UBound(a, 1) If Len(txt) = Len(a(i, 1)) Then For Each m In .Execute(txt) .Pattern = m.Value If Not .Test(a(i, 1)) Then flg = True : Exit For End If Next If Not flg Then myMatch = i : Exit For End If flg = False End If Next End If End With myMatch = IIf(IsEmpty(myMatch), CVErr(xlErrNA), myMatch) End Function それとも、 1 C14H14O3N3Na の各分子?がA列のどこかにあればその分子を列記? ですか? (seiya) コード修正 18:43 ---- seiyaさんのコードを使わせて頂きました。 Sub try() Dim myAdd As Variant 'ワークシート2のA列の範囲は適宜修正で myAdd = myMatch2(Worksheets("Sheet1").Range("A1").Value, _ Worksheets("Sheet2").Range("A1:A100")) If IsError(myAdd) Then MsgBox "見つからないです": Exit Sub Worksheets("Sheet2").Activate Range("A" & myAdd).Select End Sub Function myMatch2(ByVal txt As String, rng As Range) As Variant Dim a, b(), i As Long, m As Object, n As Object, flg As Boolean '<-変数 n 追加 a = rng.Columns(1).Value With CreateObject("VBScript.RegExp") .Pattern = "([A-Z][a-z]?)(¥d+)?" '<-元の位置に .Global = True If .Test(txt) Then Set n = .Execute(txt) '<-追加 For i = 1 To UBound(a, 1) For Each m In n '<-修正 .Pattern = m.Value If Not .Test(a(i, 1)) Then flg = True: Exit For End If Next If Not flg Then myMatch2 = i: Exit For End If flg = False Next 'If Not IsEmpty(myMatch) Then ' .Pattern = "([A-Z][a-z]?)(¥d+)?" ' Set m = .Execute(a(i, 1)) ' ReDim b(m.Count - 1) ' For i = 0 To m.Count - 1 ' b(i) = m.Item(i) ' Next 'End If End If End With myMatch2 = IIf(IsEmpty(myMatch2), CVErr(xlErrNA), i) End Function 8/27 21:23 修正 マクロ"try"を実行して下さい。 ⇒シート2のA列を選択出来ればいいのですよね? （じゅんじゅん） ---- > 検索で並びの異なるSheet1のA1と、Sheet2のA10が一致することを確認して > Sheet2のA10をアクティブにしたいのです。 でしたね... 私は A B C D E F 1 C14H14O3N3Na C14 H14 O3 N3 Na ^^^^ ^^^^ ^^^ ^^^ ^^ これが最後まで引っかかってました。 (seiya) ---- seiyaさん 3度目の衝突です。←ちょっと凄いですね。 >1 C14H14O3N3Na >とSheet2 のA列の各分子?がすべて一致する行番号(10)を知りたい そうです。並びが違っても一致する物質を抽出（アクティブ）にしたいのです。 コードこれから、確認してみます。←すみません、あすになります。ごめんなさい! じゅんじゅんさん 早速の対応ありがとうございます。 試したところ、最初のC14を含む物質に当たりつくようです。 並びは違っても次のH,N,O等の数が全て同じものを抽出したいです。 これから、退社の予定なので、確認はあすになります。 seiyaさん、じゅんじゅんさんありがとうございました。 今日は、これで失礼します。 (Chem坊) ---- i = 1 の .Execute(txt) に対しての pattern は .Pattern = "([A-Z][a-z]?)(¥d+)?" ですがi = 2 以降【配列変数:a】での pattern は .Pattern = m.Value になっているようですので修正してみました。 （じゅんじゅん） ---- 修正してみましたが何か違っているようです。。。。。（じゅんじゅん） ---- お邪魔でなければいいのですが・・・ ちょっと違ったアプローチといいますか 私自身が正規表現が苦手なのもあって順当に文字列処理でやってみたので 参考程度にアップさせてください。 Sub test() Dim a As Variant, b As Variant, v As Variant Dim i As Long, j As Long, Hit As Long With Worksheets("Sheet1") .Range("B1", .Range("B1").End(xlToRight)).ClearContents a = StrSplit(.Range("A1").Value) .Range("B1").Resize(, UBound(a) + 1).Value = a End With mySort a v = Worksheets("Sheet2").Range("A1").CurrentRegion.Value For i = 1 To UBound(v) b = StrSplit(CStr(v(i, 1))) If UBound(a) = UBound(b) Then mySort b Hit = 0 For j = 0 To UBound(a) If a(j) = b(j) Then Hit = Hit + 1 Else Exit For End If Next j If Hit = UBound(a) + 1 Then With Worksheets("Sheet2") .Select .Range("A" & i).Select End With Exit Sub End If End If Next i End Sub Private Sub mySort(ByRef ary As Variant) Dim i As Long, j As Long, buf As String For i = 0 To UBound(ary) For j = i + 1 To UBound(ary) If ary(i) > ary(j) Then buf = ary(j): ary(j) = ary(i): ary(i) = buf End If Next j Next i End Sub Private Function StrSplit(strDat As String) As Variant Dim i As Long, strBuf As String For i = 1 To Len(strDat) strBuf = Mid$(strDat, i, 1) StrSplit = StrSplit & IIf(strBuf Like "[A-Z]", "," & strBuf, strBuf) Next i StrSplit = Split(Mid$(StrSplit, 2), ",") End Function （momo） ---- 修正しました。（じゅんじゅん） ---- seiyaさん、じゅんじゅんさん、m o m oさん 皆さんお早うございます。 皆さんに作成していただいた、マクロ全てが目的の物質を抽出しました。 長時間にわたって付き合っていただきありがとうございました。 次回の質問では、もっと皆さんに早く理解していただけるようにしたいと思います。 VBA初心者ですが、これを機会に勉強したいと思います。 (Chem坊)... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/200907/20090722151922.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97023 documents and 608155 words.
訪問者：