Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10全般 : 指定なし)
セルの内容からキーワードで抜き出し、別のセルに書き出したい。
投稿日時: 19/10/22 11:15:10
投稿者: ヒロT

初めて投稿します。アドバイス宜しくお願いします。
 
エクセルでの表で、最終列(AA)に備考欄がり、そのセルの内容に書かれている内容
(下記)から、必要なデータのみ抜粋し、表の最終行の下に転記したいのですが、
抜粋が上手く行きません。元セルの書き方が改行があったりなかったり、台数も
何台かは変化します。例では1〜3台ですが、1台のみ、2台の場合、1〜5台も有。
「−」〇〇運転時「:」〇〇〇 setting XX.X LLL の書き方は、定型です。
1〜3は、ONE 、TWO、 THREE に置き換え、運転時→IS RUNNING に置き換え、英数字のみの表示
になります。/で区切って、1行表示に書き出すのが最終型です。
 
[AAセル内容]
〇△◇〇△◇〇△◇〇△◇〇△◇〇△◇(内容はいろいろです)
値は、運転台数により設定値を変える。
- 1台運転時 : HIGHT setting 11.1μg/L
- 2台運転時 : LOW setting 22.2μg/L
- 3台運転時 : LOW setting 33.3μg/L
 
 
[最終行の次のセル]
ONE IS RUNNING:HIGHT SETTING 11.1/ TWO IS RUNNING:LOW SETTING 22.2 / THREE IS RUNNING:LOW SETTING 33.3
 
 
 
以上、どなたか、お助け願えませんでしょうか。
宜しくお願いします。

回答
投稿日時: 19/10/22 13:09:48
投稿者: simple

内容を確認したいと思います。
 
Q1. 提示されたサンプルは、1つのセルに書いてあるものですか?
 
Q2. 改行もありということですが、改行位置はランダムなんですか?
    - 1台運転時 : HI【改行コード】GHT setting 11.1μg/L
    などと言うこともありえるのでしょうか?
 
Q3. 標準的なものだけでなく、トリッキーな例も、あといくつか示してください。
    回答者の皆さんとの間でやりとりする材料にできるのではないかと思います。
 
なお、部分的でも結構ですから、トライされたものがあれば示して下さい。

回答
投稿日時: 19/10/22 13:22:53
投稿者: simple

追加です。
AA列の備考欄の特定セルというのは1つだけですか?
もし複数合った場合、その結果はどう表示するのでしょう。
# ちなみに、私自身はこれから外出しますので、回答は少し後になります。

回答
投稿日時: 19/10/22 14:32:14
投稿者: WinArrow
投稿者のウェブサイトに移動

simpleさんの質問に追加します。
  
列AAのセルには、数式は入っていませんよね?
  
列AAのセルの「値」から抽出・・・
別セル(右隣のセル)に格納?
したほうが、わかりやすいかも
 
※アドバイス
設定値のリストは、どこかのセルに表として作成したほうが、
 設定値の増減/変更などの対応が楽だと思います。
 

回答
投稿日時: 19/10/22 14:48:51
投稿者: WinArrow
投稿者のウェブサイトに移動

列AAのセルの中には
「○台運転時」という文字列が1つ以下存在するという前提で
右(AB列)セルに次のような数式を入力します。
=IF(COUNTIF(AA2,"*台運転時*"),MID(AA2,FIND("台運転時",G1)-1,1),"")
この数式で、○部分が取得できます。
最終行では、AB列セルの○(数字)の存在チェック(COUNTIF)で、変換する数式を組みたてれば
という案です。
VBAは不要です。

回答
投稿日時: 19/10/22 22:06:19
投稿者: simple

追加の説明をいただいていない(残念!)ので、
質問は完成していないように思いますが、
こちらの都合もあり、前提をおいて試しにコードを作ってみました。
参考にしてください。

Sub test()
    Dim numeric As Variant
    Dim reg     As Object
    Dim matches As Object
    Dim m       As Object
    Dim s       As String
    Dim k       As Long
    
    numeric = Array("ONE", "TWO", "THREE", "FOUR", "FIVE")

    '正規表現のセット
    Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Pattern = "(\d+)台運転時 : ((.*?)((?:\d|\.)+))"
        .IgnoreCase = True    '大文字と小文字をしない
        .Global = True        '繰り返し検索
    End With
    
    s = Range("A1").Value      '対象とする文字列が入っているセル(仮)
    
    '正規表現によるパターンマッチの実行
    Set matches = reg.Execute(s)
    
    ' 結果の編集
    ReDim ss(1 To matches.Count)
    For Each m In matches
        k = k + 1
        ss(k) = numeric(m.submatches(0) - 1) & " IS Running:" & m.submatches(1)
    Next
    '書込み
    Range("A2").Value = UCase(Join(ss, "/ ")) '書込場所は仮です。
End Sub

 
■留意点:
・文字列の全角半角は提示どおりにしているので、実際と違っていれば、結果は出ません。
  特に、運転時のあとの空白や:は全角と仮定しました。
 
・セルの場所が不明だったので、サンプルにとどめ、
  A1セルの文字列を対象に、結果をA2セルに書くこととしています。
  そちらで簡単に修正が可能と思います。
・色々なエラー対応等は端折っています。
 
■上記コードの動作結果
A1セル(前提)
 - 1台運転時 : HIGH setting 11.1μg/L
 - 2台運転時 : LOW setting 22.2μg/L
 - 3台運転時 : LOW setting 33.3μg/L
 
A2セル(結果)
ONE IS RUNNING:HIGH SETTING 11.1/ TWO IS RUNNING:LOW SETTING 22.2/ THREE IS RUNNING:LOW SETTING 33.3
 

投稿日時: 19/10/22 22:09:10
投稿者: ヒロT

ヒロT さんの引用:
初めて投稿します。アドバイス宜しくお願いします。
 
エクセルでの表で、最終列(AA)に備考欄がり、そのセルの内容に書かれている内容
(下記)から、必要なデータのみ抜粋し、表の最終行の下に転記したいのですが、
抜粋が上手く行きません。元セルの書き方が改行があったりなかったり、台数も
何台かは変化します。例では1〜3台ですが、1台のみ、2台の場合、1〜5台も有。
「−」〇〇運転時「:」〇〇〇 setting XX.X LLL の書き方は、定型です。
1〜3は、ONE 、TWO、 THREE に置き換え、運転時→IS RUNNING に置き換え、英数字のみの表示
になります。/で区切って、1行表示に書き出すのが最終型です。
 
[AAセル内容]
〇△◇〇△◇〇△◇〇△◇〇△◇〇△◇(内容はいろいろです)
値は、運転台数により設定値を変える。
- 1台運転時 : HIGHT setting 11.1μg/L
- 2台運転時 : LOW setting 22.2μg/L
- 3台運転時 : LOW setting 33.3μg/L
 
 
[最終行の次のセル]
ONE IS RUNNING:HIGHT SETTING 11.1/ TWO IS RUNNING:LOW SETTING 22.2 / THREE IS RUNNING:LOW SETTING 33.3
 
 
 
以上、どなたか、お助け願えませんでしょうか。
宜しくお願いします。

 
【追記】
simpleさん, WinArrowさん、早速アクションして頂きありがとうございます。
情報を追記させて頂きます。
A〜AA列 の構成で、C,D,E,Fの列名は、HIGH1,HIGH2,LOW1,LOW2 で、数値の価が入ります。
G列にMEMO と表記がある場合に、AA列の備考欄の内容(C〜Fの設定値の変更内容を表示)
があります。
MEMO を上位から*1〜連番をつける。
 
 
   A  B  C  D  E  F  G   〜    AA
1
2 1.0 MEMO (上記セルの内容など)
3
4 2.0 MEMO
5
6
7 1.5 MEMO


100  (最終行は都度変化)
       *1 ONE IS RUNNING:HIGHT SETTING 11.1/ TWO IS RUNNING:LOW SETTING 22.2 / THREE IS RUNNING:LOW SETTING 33.3
       *2 ONE IS RUNNING:HIGHT SETTING 11.1/ TWO IS RUNNING:LOW SETTING 22.2 /
       *3 ONE IS RUNNING:HIGHT SETTING 11.1
 
------------------------------------------------------
G列のMEMO の数だけ、最終行以降に*1〜で行を追加するまではできています。
が、その備考を抜き出して表示する部分ができません。
コード表示は、他のプログラムと絡みがり、これは、質問用にアレンジしております。
 
simpleさん
Q1:一つのセルの内容です
Q2:改行のトリガーは、設定値の単位の後、or 行頭の「−」前かです。
Q3:できるだけ標準的なこのパターンで、アレンジしようと思います。
 
WinArrowさん
はい、書き出し用に列を設けることは、考えておりました。
やはり、そのほうがいいですかねぇ・・・・・

投稿日時: 19/10/22 22:40:45
投稿者: ヒロT

simple さんの引用:
追加の説明をいただいていない(残念!)ので、
質問は完成していないように思いますが、
こちらの都合もあり、前提をおいて試しにコードを作ってみました。
参考にしてください。
Sub test()
    Dim numeric As Variant
    Dim reg     As Object
    Dim matches As Object
    Dim m       As Object
    Dim s       As String
    Dim k       As Long
    
    numeric = Array("ONE", "TWO", "THREE", "FOUR", "FIVE")

    '正規表現のセット
    Set reg = CreateObject("VBScript.RegExp")
    With reg
        .Pattern = "(\d+)台運転時 : ((.*?)((?:\d|\.)+))"
        .IgnoreCase = True    '大文字と小文字をしない
        .Global = True        '繰り返し検索
    End With
    
    s = Range("A1").Value      '対象とする文字列が入っているセル(仮)
    
    '正規表現によるパターンマッチの実行
    Set matches = reg.Execute(s)
    
    ' 結果の編集
    ReDim ss(1 To matches.Count)
    For Each m In matches
        k = k + 1
        ss(k) = numeric(m.submatches(0) - 1) & " IS Running:" & m.submatches(1)
    Next
    '書込み
    Range("A2").Value = UCase(Join(ss, "/ ")) '書込場所は仮です。
End Sub

 
■留意点:
・文字列の全角半角は提示どおりにしているので、実際と違っていれば、結果は出ません。
  特に、運転時のあとの空白や:は全角と仮定しました。
 
・セルの場所が不明だったので、サンプルにとどめ、
  A1セルの文字列を対象に、結果をA2セルに書くこととしています。
  そちらで簡単に修正が可能と思います。
・色々なエラー対応等は端折っています。
 
■上記コードの動作結果
A1セル(前提)
 - 1台運転時 : HIGH setting 11.1μg/L
 - 2台運転時 : LOW setting 22.2μg/L
 - 3台運転時 : LOW setting 33.3μg/L
 
A2セル(結果)
ONE IS RUNNING:HIGH SETTING 11.1/ TWO IS RUNNING:LOW SETTING 22.2/ THREE IS RUNNING:LOW SETTING 33.3
 

 
simpleさん
とても丁寧なメッセージありがとうございます。
追記で回答したのですが、自分にあてて・・・('Д')申し訳なしです。
早速トライしてみます。
 
 

回答
投稿日時: 19/10/24 09:46:13
投稿者: simple

今気づきましたが、途中にHIGH1 LOW1といった数値が入るという話ではなかったので
正規表現パターンに修正が必要ですね。

       .Pattern = "(\d+)台運転時 : (.*?setting\s*(?:\d|\.)+)"
ではどうですか。
# 正規表現が初めてであれば(たぶんそうでしょうけど)、ちょっと唖然という感じでしょうか。
# 質問があれば解説する用意はありました。
別のアプローチのほうがよかったかも知れません。(私はその気になれませんでしたが)

トピックに返信