[[20140911174636]]　『リストビューに値を設定したい』（一郎）　ページの最後に飛ぶ

『リストビューに値を設定したい』（一郎）

 こんばんは
 昨日は[[20140909163252]]の質問にてお世話になりました。
 先日の質問は、文字列を抜き出してその値をリストボックスに設定したいということでした。
 が、リストビューに変更できないかと言われました。

 1.{AAAAAA(BBBBBB,CCCCCC),DDDDDD(EEEEEE),FFFFFF}

 1のようなデータを以下のように表示したいです。
 __カラム1__ __カラム2__
   AAAAAA      BBBBBB
               CCCCCC
   DDDDDD      EEEEEE
   FFFFFF

 splitで区切ればよいかとも思いましたが、そうすると
 細かくなりすぎてしまいます。
 どう実現したらよいでしょうか。

 ※追記
 どうしてもやり方が思い浮かびません。
 __カラム1__ __カラム2__
   AAAAAA      BBBBBB
   AAAAAA      CCCCCC
   DDDDDD      EEEEEE
   FFFFFF

 でもよいので何かないでしょうか…

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

少しは自分で考えたという成果を見せて欲しいものです。
でもって、実はまたListViewは2つ有り…、なんですよね？

 Private Sub UserForm_Initialize()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim kMax As Long
    Dim iSt As Long
    Dim iEd As Long
    Dim iNum As Long
    Dim cw As String
    Dim cItem As String
    Dim cSub As String
    Dim vw1 As Variant
    Dim vw2 As Variant

    With ListView1
        .ColumnHeaders.Clear
        .ListItems.Clear
        .View = lvwReport
        .ColumnHeaders.Add , , "main", 60
        .ColumnHeaders.Add , , "sub", 120
    End With

    With ListView2
        .ColumnHeaders.Clear
        .ListItems.Clear
        .View = lvwReport
        .ColumnHeaders.Add , , "main", 60
        .ColumnHeaders.Add , , "sub", 120
    End With

    With Sheets(1)
        For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
            iSt = 1
            cw = Replace(.Cells(i, "A").Text, "{", "")
            If Right(cw, 1) = "}" Then
                iNum = 1
            Else
                iNum = 0
            End If

            cw = Replace(cw, "}", "")
            If Right(cw, 1) <> ")" Then
                cw = cw & "()"
            End If

            cw = cw & ","
            vw1 = Split(cw, "),")

            For j = 0 To UBound(vw1)
                iSt = InStr(vw1(j), "(")
                If 0 < iSt Then
                    cItem = Left(vw1(j), iSt - 1)
                    vw2 = Split(Mid(vw1(j), iSt + 1), ",")
                    kMax = UBound(vw2)
                    If kMax < 0 Then
                        kMax = 0
                    End If

                    For k = 0 To kMax
                        If UBound(vw2) < 0 Then
                            cSub = ""
                        Else
                            cSub = vw2(k)
                        End If

                        If iNum = 0 Then
                            With ListView1.ListItems.Add
                                .Text = cItem
                                .SubItems(1) = cSub
                            End With
                        Else
                            With ListView2.ListItems.Add
                                .Text = cItem
                                .SubItems(1) = cSub
                            End With
                        End If
                    Next k
                End If
            Next j
        Next i
    End With
End Sub
（???） 2014/09/12(金) 11:11

 ???さん

 お世話になります。

 ゴリゴリと処理するものを書いてみました
 それが以下になります
 ???さんのコードも検証してみたいと思います！
 ありがとうございます。
 Sub test()

    Dim i             As Long
    Dim strText       As String
    Dim lngStart      As Long
    Dim lngStart2     As Long
    Dim lngEnd        As Long
    Dim lngEnd2       As Long

    Dim index         As Long

    Dim strtemp1      As String
    Dim strtemp2      As String
    Dim vnttemp1      As Variant
    Dim vnttemp2      As Variant
    Dim vnttbl1       As Variant
    Dim vnttbl2       As Variant

    lngStart = 1
    index = 0
    strText = Replace("{C1,C2(P1,P2)}", "{", "")
    strText = Replace(strText, "}", "")

    ReDim vnttbl1(0)
    ReDim vnttbl2(0)

    '文字の初めから最初のカンマまで切り出した時、「(」が含まれているか
    Do While strText <> ""

        'カンマの位置を探す
        lngEnd = InStr(lngStart, strText, ",")

        '「(」が含まれているか
        If 0 < InStr(Mid(strText, lngStart, lngEnd - iSt), "(") Then

            '切り出し開始位置
            lngStart2 = InStr(lngStart, strText, "(") + 1
            '切り出し終了位置
            lngEnd = InStr(lngStart, strText, ")")
            '()内の文字列終了位置
            lngEnd2 = lngEnd - lngStart2
            '次の「)」までの文字を切り出す
            strtemp2 = Mid(strText, lngStart, lngEnd)

            '「()」の前の文字と「()」内の文字に分割する
            '()より前の文字を取得
            vnttemp1 = Left(strtemp2, InStr(strtemp2, "(") - 1)

            '()内の文字を取得して「,」で分割
            vnttemp2 = Split(Mid(strText, lngStart2, lngEnd2), ",")

            '分割した文字列を配列に入れる
            For i = 0 To UBound(vnttemp2)
                ReDim Preserve vnttbl1(index)
                ReDim Preserve vnttbl2(index)
                If i = 0 Then
                    vnttbl1(index) = vnttemp1
                Else
                    vnttbl1(index) = ""
                End If
                vnttbl2(index) = Replace(vnttemp2(i), " ", "")
                index = index + 1
            Next i

            '与えられた文字列から切り出した文字列を消す
            strText = Replace(strText, strtemp2, "")
        Else
            'No
            '切り出して配列に入れる
            ReDim Preserve vnttbl1(index)
            ReDim Preserve vnttbl2(index)
            vnttbl1(index) = Mid(strText, lngStart, lngEnd - lngStart)
            vnttbl2(index) = "unspecified"
            '与えられた文字列から切り出した文字列を消す
            strText = Replace(strText, vnttbl1(index) & ",", "")
            index = index + 1
        End If
    Loop
 End Sub
（一郎） 2014/09/12(金) 11:28

 ???さんお世話になります

 検証を行っていましたが、{AAAAAA, BBBBBB(CCCCCC,DDDDDD)}という
 データがあった場合、ListItemsにAAAAAA, BBBBBBと表示されてしまいます…
 cItem = Left(vw1(j), iSt - 1)
 vw2 = Split(Mid(vw1(j), iSt + 1), ",")
 あたりを直せばいいとは思うのですが、どのようにしたらよいでしょうか
（一郎） 2014/09/12(金) 14:07

末尾以外にも、括弧無しがあるんですね。やはり規則性が伝わってなかったようです。
修正方法としては、括弧に囲まれていないところでカンマがあった場合、直前に括弧を付加すること。
（{AAAAAA(),BBBBBB(CCCCCC,DDDDDD)} のようにすることで、以降のSplitで処理できるようにする）

 Private Sub UserForm_Initialize()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim kMax As Long
    Dim iEd As Long
    Dim iSt As Long
    Dim iNum As Long
    Dim cw As String
    Dim cItem As String
    Dim cSub As String
    Dim vw1 As Variant
    Dim vw2 As Variant

    With ListView1
        .ColumnHeaders.Clear
        .ListItems.Clear
        .View = lvwReport
        .ColumnHeaders.Add , , "main", 60
        .ColumnHeaders.Add , , "sub", 120
    End With

    With ListView2
        .ColumnHeaders.Clear
        .ListItems.Clear
        .View = lvwReport
        .ColumnHeaders.Add , , "main", 60
        .ColumnHeaders.Add , , "sub", 120
    End With

    With Sheets(1)
        For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
            iSt = 1
            cw = Replace(.Cells(i, "A").Text, "{", "")
            If Right(cw, 1) = "}" Then
                iNum = 1
            Else
                iNum = 0
            End If

            cw = Replace(cw, "}", "")
            If Right(cw, 1) <> ")" Then
                cw = cw & "()"
            End If
            cw = cw & ","

            iEd = InStr(cw, ",")
            iSt = InStr(cw, "(")

            While iEd < iSt
                cw = Left(cw, iEd - 1) & "()" & Mid(cw, iEd)
                iEd = InStr(iEd + 3, cw, ",")
                iSt = InStr(iEd + 3, cw, "(")
            Wend

            vw1 = Split(cw, "),")

            For j = 0 To UBound(vw1)
                iSt = InStr(vw1(j), "(")
                If 0 < iSt Then
                    cItem = Left(vw1(j), iSt - 1)
                    vw2 = Split(Mid(vw1(j), iSt + 1), ",")
                    kMax = UBound(vw2)
                    If kMax < 0 Then
                        kMax = 0
                    End If

                    For k = 0 To kMax
                        If UBound(vw2) < 0 Then
                            cSub = ""
                        Else
                            cSub = vw2(k)
                        End If

                        If iNum = 0 Then
                            With ListView1.ListItems.Add
                                .Text = cItem
                                .SubItems(1) = cSub
                            End With
                        Else
                            With ListView2.ListItems.Add
                                .Text = cItem
                                .SubItems(1) = cSub
                            End With
                        End If
                    Next k
                End If
            Next j
        Next i
    End With
End Sub
（???） 2014/09/12(金) 14:58

 ???さん

 条件後出しで誠に申し訳ありません
 { }で囲まれた値の個数、()で囲まれた値の個数は不定なんです
 そういった条件に対応するためには、
 While iEd < iSt
    cw = Left(cw, iEd - 1) & "()" & Mid(cw, iEd)
    iEd = InStr(iEd + 3, cw, ",")
    iSt = InStr(iEd + 3, cw, "(")
 Wend
 を修正？すればよいでしょうか
（一郎） 2014/09/12(金) 15:09

若干修正。iStとiEdに値セットする順番を、以下のようにしてください。

            iSt = InStr(cw, "(")
            iEd = InStr(cw, ",")

            While iEd < iSt
                cw = Left(cw, iEd - 1) & "()" & Mid(cw, iEd)
                iSt = InStr(iEd + 3, cw, "(")
                iEd = InStr(iEd + 3, cw, ",")
            Wend

ところで個数が不特定なのは、最初からそのつもりでコーディングしてますよ。
それよりも、データ中に空白が無いことを想定しているので、もし空白が存在するならば、
cwを編集しているあたりで空白除去しておいてください、

予め、要求全てを確認できるデータと結果予想を提示してくれれば、誤解が無いです。
（???） 2014/09/12(金) 15:18

 ???さんお世話になります

 空白の件は承知致しました。

 データについてですが、以下の通りです。

 ■データ要件
 1.()なしのデータ
 2.()ありのデータ

 データ例.{A,B(C,D),E,F,G,H}
 期待する結果
 __カラム1__ __カラム2__
     A      
     B           C
     B           D
     E
     F
     G
     H
 ()なしのデータはそのまま表示
 ()ありのデータは、()の直前の文字列をカラム1に、()の中のデータはカラム2に表示したいです
  上記のようなデータですと、DEFGが1行に表示されてしまいます…
 すみません。若干修正しました。
（一郎） 2014/09/12(金) 15:33

括弧なしデータが複数ある、という事ですね。
ならば、やはりcwを編集している箇所を変えれば良いので、While部分を変更してみてください。

            While 0 < iEd
                If iEd < iSt Then
                    If Mid(cw, iEd - 1, 1) <> ")" Then
                        cw = Left(cw, iEd - 1) & "()" & Mid(cw, iEd)
                    End If
                End If
                iSt = InStr(iEd + 3, cw, "(")
                iEd = InStr(iEd + 3, cw, ",")
            Wend
（???） 2014/09/12(金) 15:47

 ???さんお世話になります
 {A,B(C,D),E,F,G,H}で検証したところ、E,Fが1行で表示されてしまいます…
 If Mid(cw, iEd - 1, 1) <> ")" Then
    cw = Left(cw, iEd - 1) & "()" & Mid(cw, iEd)
 End If
 の条件が肝だと思うのですが…
 また、()付きのデータも複数あります。
 大変申し訳あありません
（一郎） 2014/09/12(金) 16:05

 ???さんお世話になります
 以下のようにすることで思い通りの結果が得られました！
 もっとスマートな方法があれば教えて頂きたいです
    blnFlg = False

    While 0 < iEd
        If iEd < iSt Then
            If Mid(cw, iEd - 1, 1) <> ")" Then
                cw = Left(cw, iEd - 1) & "()" & Mid(cw, iEd)
            End If
            blnFlg = True
        End If
        If blnFlg Then
            iSt = InStr(iEd + 1, cw, "(")
            iEd = InStr(iEd + 1, cw, ",")
            blnFlg = False
        Else
            iSt = InStr(iEd + 3, cw, "(")
            iEd = InStr(iEd + 3, cw, ",")
        End If
    Wend
（一郎） 2014/09/12(金) 16:11

「(),」で3文字飛ばしていましたが、「,E,F,」の場合だと、1つ飛び越してますね。
While文内の、次の文字を探す箇所を、以下のように変更してみてください。

                iSt = InStr(iEd + 2, cw, "(")
                iEd = InStr(iEd + 2, cw, ",")
（???） 2014/09/12(金) 16:28

 ???さんお世話になります。

 +3を+2に変更したら、良い結果が得られました！
 長々とお付き合い頂きありがとうございました。

 差し支えなければ教えて頂きたいのですが、柔軟な発想はどのようにしたらできるようになるのでしょうか
（一郎） 2014/09/12(金) 16:36

コーディングの際、簡単な命令で、短く実現することを常に意識します。
ある程度は理詰めですが、更に簡単にする方法を思いつけるかどうかは、経験と感性でしょうね。慣れですよ。
（???） 2014/09/12(金) 17:13

 正規表現で

 Private Sub UserForm_Initialize()
    Dim r As Range, mtch As Object, m As Object, e
    Dim RegX As Object
    Set RegX = CreateObject("VBScript.RegExp")
    RegX.Global = True
    With Me.ListView1
        .ColumnHeaders.Add , , "MainItem", 60
        .ColumnHeaders.Add , , "SubItem", 60
    End With
    For Each r In Sheets(1).Columns(1).SpecialCells(2)
        RegX.Pattern = "[^\{\},\(\)]+(?!\()|,[^\(]+\([^\)]+\)"
        Set mtch = RegX.Execute(r.Value)
        For Each m In mtch
            RegX.Pattern = "([^,]+)\(([^\)]+)\)"
            If RegX.test(m.Value) Then
                For Each e In Split(RegX.Execute(m.Value)(0).submatches(1), ",")
                    With Me.ListView1.ListItems.Add
                        .Text = RegX.Execute(m.Value)(0).submatches(0)
                        .SubItems(1) = Trim$(e)
                    End With
                Next
            Else
                Me.ListView1.ListItems.Add.Text = m.Value
            End If
        Next
    Next
End Sub
（seiya） 2014/09/12(金) 18:13 チョイ修正18:37

 折角の正規表現ですから、今回の例ですと最初から最後まで使えますね。
 Executeメソッドの呼び出し回数は必要最小限に抑えるのがいいと思いますよ。

 Private Sub UserForm_Initialize()
     Dim r As Range, mtch As Object, m As Object, e
     Dim RegX As Object
     Dim lvItems As ListItems, ss As String

     Set RegX = CreateObject("VBScript.RegExp")
     RegX.Global = True
     RegX.Pattern = "([^,{}\s]+)\(([^()]+)\)|([^,\(\){}\s]+)"

     With Me.ListView1
         .ColumnHeaders.Add , , "MainItem", 60
         .ColumnHeaders.Add , , "SubItem", 60
         Set lvItems = .ListItems
     End With

     For Each r In Sheets(1).Columns(1).SpecialCells(2)
         Set mtch = RegX.Execute(r)
         For Each m In mtch
             ss = m.SubMatches(0)
             If LenB(ss) Then
                 For Each e In RegX.Execute(m.SubMatches(1))
                     With lvItems.Add
                         .Text = ss
                         .SubItems(1) = e.Value
                     End With
                 Next
             Else
                 lvItems.Add.Text = m.SubMatches(2)
             End If
         Next
     Next

 End Sub
（Abyss） 2014/09/12(金) 18:58

 > "([^,{}\s]+)\(([^()]+)\)|([^,\(\){}\s]+)"
 これだと

 {A X,B(C,D),E,F,G,H}
 なんて場合
 A
 X
 B C
 B C
 .
 .

 AとXが分離されるんだよね...
（seiya） 2014/09/12(金) 19:31

 > \s

 余計な条件を付け出したようですね。失礼。
（Abyss） 2014/09/12(金) 19:37

 みなさんこんにちは
 解決したのにも関わらずご連絡が遅くなってしまい申し訳ありませんでした。
 ありがとうございました。
（一郎） 2014/10/16(木) 11:34

コメント返信：

[ 一覧(最新更新順) ]

[[20140911174636]] 『リストビューに値を設定したい』（一郎） ページの最後に飛ぶ

[[20140911174636]]　『リストビューに値を設定したい』（一郎）　ページの最後に飛ぶ