[[20151117155140]]　『特定の文字列の抽出について。』（ちぃ）　ページの最後に飛ぶ

『特定の文字列の抽出について。』（ちぃ）

エクセルマクロ・関数について。

詳しい方ご教授お願いいたします。

セルのA、Bにある""で囲まれた文字列を
それぞれC,Dセルに表示させたいです。
※セルAをセルCに、セルBをセルDに

A、Bにある""の文字は最大10個まであり
セルによって数はランダムになります。

また""の前につく英語や数字の組み合せも
ランダムです。

何か良い方法があるでしょうか。。

よろしくおねがいいたします。

セルA
a:9:{i::"沖縄";i:1;:"那覇";i:2;2:"美ら海";}
a:9:{is:9:"アメリカ";;s:6:"ニューヨーク";i::32:"自由の女神";}

セルB
a:s:9:"北海道";i::6:"札幌";i::32:"その他";}
a:9:9:"イギリス";i:"ロンドン";i:2:"その他";}

セルC
沖縄、那覇、美ら海
アメリカ、ニューヨーク、自由の女神

セルD
北海道、札幌、その他
イギリス、ロンドン、その他

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 VBA 一例です。

 Sub Sample()
    Dim c As Range
    Dim reg As Object
    Dim wd As Object
    Dim s As String
    Dim sep As String

    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    reg.Pattern = """([^""]+?)"""
    For Each c In Range("A1", ActiveSheet.UsedRange).Columns("A:B").Cells
        If Not IsEmpty(c) Then
            s = ""
            sep = ""
            For Each wd In reg.Execute(c.Value)
                s = s & sep & wd.submatches(0)
                sep = ","
            Next
            c.Offset(, 2).Value = s
        End If
    Next
 End Sub

（β） 2015/11/17(火) 16:14

 これではどうだろうか？

 Sub HENKAN()
     Dim WK_RANGE    As Range
     Dim CHK         As Variant
     Dim Loop_Cnt    As Integer

     Set WK_RANGE = Range("A1")

     For Each WK_RANGE In Intersect(ActiveSheet.UsedRange, Range("A:B"))
         CHK = Split(WK_RANGE.Value, """")
         WK_RANGE.Offset(0, 2).Value = ""
         If UBound(CHK) > 0 Then
             WK_RANGE.Offset(0, 2).Value = CHK(1)
             For Loop_Cnt = 3 To UBound(CHK) Step 2
                 WK_RANGE.Offset(0, 2).Value = WK_RANGE.Offset(0, 2).Value & "," & CHK(Loop_Cnt)
             Next
         End If
     Next
 End Sub

（ねむねむ） 2015/11/17(火) 16:37

（β）さま　（ねむねむ）さま

さっそくのご回答ありがとうございます！
お二方ともやってみたらできました（TT)
感激しております。。。

さらにもしお分かりだったら教えていただきたいのですが
セルA セルBの両隣を２つあけて
書き出すこともできるでしょうか？

実は
セルABCDEにそれぞれ値がはいっており
セルA、Bは前述のとおりなのですが
CDEにもデータが入っており
上書きされてしまうと困るので
実行すると、

セルA
セルB
セルC(セルAの""のみを取り出したもの）
セルD(セルBの""のみを取り出したもの）
セルE（セルCの値）
セルF（セルDの値）
セルG（セルEの値）
・・・・

となるように出来れば嬉しいです。

よろしくお願いいたします。

（ちぃ） 2015/11/17(火) 16:43

 Columns("C:D").Insert Shift:=xlShiftToRight
 を最初に入れてはどうか？
（ねむねむ） 2015/11/17(火) 16:55

ねむねむ　様

できました！

ありがとうございます（TT)

本当に助かりました。

お忙しい中、ありがとうございました！
（ちぃ） 2015/11/17(火) 17:03

 解決後だが。

 力技で関数で。
 ただし""内の文字列内にスペースがないこと。

 =SUBSTITUTE(TRIM(
 MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*1,100)&" "&MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*3,100)&" "&
 MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*5,100)&" "&MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*7,100)&" "&
 MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*9,100)&" "&MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*11,100)&" "&
 MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*13,100)&" "&MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*15,100)&" "&
 MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*17,100)&" "&MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*19,100))
 ," ",",")

　C1セルに入力して右および下へフィルコピー。

 追記
 うっかりしていた。
 &" "&は必要ないな。
 =SUBSTITUTE(TRIM(
 MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*1,100)&MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*3,100)&
 MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*5,100)&MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*7,100)&
 MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*9,100)&MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*11,100)&
 MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*13,100)&MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*15,100)&
 MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*17,100)&MID(SUBSTITUTE(A1,"""",REPT(" ",100)),100*19,100))
 ," ",",")
 で。
（ねむねむ） 2015/11/17(火) 17:16

ねむねむ様

重ねがさねありがとうございます！

（ちぃ） 2015/11/18(水) 12:25

コメント返信：

[ 一覧(最新更新順) ]

[[20151117155140]] 『特定の文字列の抽出について。』（ちぃ） ページの最後に飛ぶ

[[20151117155140]]　『特定の文字列の抽出について。』（ちぃ）　ページの最後に飛ぶ