[[20170315140636]] 『配列で格納する文字列が改行以降取得できない』(なんなん) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『配列で格納する文字列が改行以降取得できない』(なんなん)

いつも勉強させていただいております。

お客様から来た問い合わせメールをコピーし、エクセルのA6セルに貼り付けたものを以下のマクロでリストにしています。

概ね問題なく格納されるのですが、R列に格納される【上記について詳しく】だけは最大1200文字の文字列で、途中で改行が入ることがあり、その場合改行前(つまり1行目)しか取得できません。

これをすべて取得しようと思ったらどうすればよいのでしょうか。
ご指南のほどよろしくお願いいたします。


メール例

【会員番号】
45584992
【お名前】
なんなんなん子
【お電話番号】
09012345678
【メールアドレス】
123@abc.co.jp
【郵便番号】
0000000
【ご住所1】
●●市△△区■■■■■■
【ご住所2】
1-2-3
【項目1】
テキストテキスト
【項目2】
テキスト
【上記について詳しく】
テキストテキストテキストテキストテキストテキスト。
テキストテキストテキストテキストテキストテキストテキスト、テキストテキストテキストテキストテキストテキスト。
テキストテキストテキストテキストテキストテキスト。
【項目5】
テキストテキスト
【項目9】
テキストテキストテキスト


 Dim wsIn As Worksheet
                Dim wsTo As Worksheet
                Dim asLines As Variant
                Dim i As Long
                Dim ixToRow As Long, ixToCol As Variant

                Set wsIn = ThisWorkbook.Worksheets("作業用")
                Set wsTo = ThisWorkbook.Worksheets("問い合わせリスト")

                asLines = Split(wsIn.Range("A6"), vbLf)

                ixToRow = wsTo.Cells(Rows.Count, "I").End(xlUp).Row + 1

                i = 0
                Do While (i <= UBound(asLines))
                    ixToCol = Empty
                    Select Case asLines(i)
                        Case "【会員番号】":              ixToCol = "H"
                        Case "【お名前】":                  ixToCol = "I"
                        Case "【お電話番号】":              ixToCol = "J"
                        Case "【FAX番号】":                 ixToCol = "K"
                        Case "【メールアドレス】":          ixToCol = "L"
                        Case "【郵便番号】":                ixToCol = "M"
                        Case "【ご住所1】":                 ixToCol = "N"
                        Case "【ご住所2】":                 ixToCol = "O"
                        Case "【項目1】":                   ixToCol = "P"
                        Case "【項目2】":                   ixToCol = "Q"
                        Case "【上記について詳しく】":      ixToCol = "R"
                        Case "【項目3】":                   ixToCol = "S"
                        Case "【項目4】":                   ixToCol = "T"
                        Case "【項目5】":                   ixToCol = "U"
                        Case "【項目6】":                   ixToCol = "V"
                        Case "【項目7】":                   ixToCol = "W"
                        Case "【項目8】":                   ixToCol = "X"
                        Case "【項目9】":                   ixToCol = "Y"
                        Case "【項目10】":                  ixToCol = "Z"
                        Case "【項目11】":                  ixToCol = "AA"
                        Case "【項目12】":               ixToCol = "AB"
                        Case "【項目13】":                  ixToCol = "AC"
                        Case "【項目14】":                  ixToCol = "AD"

                    End Select
                    If Not IsEmpty(ixToCol) Then
                        wsTo.Cells(ixToRow, ixToCol) = "'" & asLines(i + 1)
                        i = i + 1
                    End If

                    i = i + 1
                Loop


< 使用 Excel:Excel2010、使用 OS:Windows7 >


考え方だけですが、

1)1回めのSplitを、vbLf & "【" で実行し、
2)各要素を、"】" & vbLfでSplitして判定してはどうでしょうか

そうすれば今のコードの微修正でできそうな気がします。

(マナ) 2017/03/15(水) 20:24


    asLines = Split(wsIn.Range("A6"), vbLf)

この1行を、以下のように変更でも良いかと思います。(一旦改行コードを全て消して、括弧の前後で改めて改行する)

    asLines = Replace(wsIn.Range("A6"), vbLf, "")
    asLines = Replace(asLines, "【", vbLf & "【")
    asLines = Replace(asLines, "】", "】" & vbLf)
    asLines = Split(asLines, vbLf)
(???) 2017/03/15(水) 20:46

なるほどです。改行を残したければ、これでもよいですね。

asLines = Replace(wsIn.Range("A6"), "【", vbLf & "【")
asLines = Replace(asLines, "】", "】" & vbLf)
asLines = Split(asLines, vbLf & vbLf)

(マナ) 2017/03/15(水) 21:11


お礼が遅くなり申し訳ありません。
意図していた処理ができました。
プログラムは奥が深いですね。大変勉強になりました。
ありがとうございました。
(なんなん) 2017/03/21(火) 14:51

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.