[[20130316165550]]　『マクロでの改行を考慮した文字貼り付け』（konkonbonbon）　ページの最後に飛ぶ

『マクロでの改行を考慮した文字貼り付け』（konkonbonbon）

マクロで一つのセルに次のような内容があるとします。

　あいうえおかきく
　１２３４５
　abcdefg

これを他の複数のセルに５文字ずつコピーしたいのでが，セル内で改行があったときは，５文字に満たなくても次の行に値をコピーしたいのです。
出力結果を書くと，

　あいうえお
　かきく
　１２３４５
　abcde
　ef

と連続したセルにコピーするにはどうしたらいいでしょうか？

[Excel2010，Windows 7]

 正規表現を使うと、もう少しスマートに書けると思うけど面倒（？）なので平文で。
 A1に値があるとしてA2以降のA列に生成。
 なお、改行はエクセル標準の LF とする。（最後は ef ではなく fg だよね？）

 Sub Sample()
    Dim v As Variant
    Dim w() As Variant
    Dim d As Variant

    v = Split(Range("A1"), vbLf)
    ReDim w(1 To 1)

    For Each d In v
        Do
            ReDim Preserve w(1 To UBound(w) + 1)
            If Len(d) > 5 Then
                w(UBound(w) - 1) = Left(d, 5)
                d = Mid(d, 6)
            Else
                w(UBound(w) - 1) = d
                Exit Do
            End If
        Loop
    Next
    ReDim Preserve w(1 To UBound(w) - 1)
    Range("A2").Resize(UBound(w)).Value = WorksheetFunction.Transpose(w)
 End Sub

 (ぶらっと)

 一応、正規表現で処理するコードも。（自信度８０％ぐらい？）

 追記）↓　やっぱりバグ有り。とりあえず以下は無視してSampleを。
 追記）20:27 バグ修正（したつもり）

 Sub Sample2()
    Dim s As String
    Dim w As Variant

    s = Range("A1").Value
    With CreateObject("VBSCript.RegExp")
        .Global = True
        .Pattern = "(.{5})"
        s = .Replace(s, "$1" & vbLf)
    End With
    s = Replace(s, vbLf & vbLf, vbLf)
    w = Split(s, vbLf)
    Range("A2").Resize(UBound(w) + 1).Value = WorksheetFunction.Transpose(w)
 End Sub

 (ぶらっと)

すいません。もう一つ質問です。
sample2のようなアイディアが思いつきませんでした…。素晴らしい。
さて，さらに5文字という制限の他に，禁則処理を入れたいのです。
具体的に，貼り付けた後の先頭の文字が「。」や「，」で始まらないように
6文字目が禁則処理に当てはまるときだけ，その列のみ6文字で処理する方法はどうすればいいでしょうか？

あああああ，いいい
ううう。えええ

だった場合

あああああ，
いいい
ううう。え
え

となるようにしたいのです。
よろしくお願いします。（konkonbonbon）

 もし、

 あああああ,,いいい

 だった場合は？
 6文字ということなら

 あああああ,
 ,いいい

 になってしまうね。

 6文字ということじゃなく禁則文字で始まれば、その禁則文字を前のセルの文字列に移動する、つまり

 あああああ,,
 いいい

 ということなら やってみるけど？

 追記）そもそもが　元の文字列の最初の文字が禁則文字だったらどうしようか？

 (ぶらっと)

 たとえば　文字列が　あいうえお、かきくけこ　だったとする。
 従来のロジックでは

 あいうえお
 、かきくけ
 こ

 の３行になる。

 で、２行目の禁則文字を１行目の末尾に持って行ったとして

 あいうえお、
 かきくけ
 こ

 これでいいなら以下。

 Sample の Range("A2").Resize(UBound(w)).Value = WorksheetFunction.Transpose(w)
 および Sample2 の Range("A2").Resize(UBound(w) + 1).Value = WorksheetFunction.Transpose(w)

 これらの１行上に　AdjustNGChar w　と記述。

 で、以下のプロシジャを追加。

 Sub AdjustNGChar(w As Variant)
    Dim i As Long
    Dim obj As Object
    Dim z As String
    Dim s As String

    With CreateObject("VBSCript.RegExp")
        'Array内に禁則文字をいくつでも。ここでは半角と全角のカンマと 。の 3つを指定。
        .Pattern = "^[" & Join(Array(",", "、", "。"), "|") & "]+"
        For i = LBound(w) + 1 To UBound(w)
            Set obj = .Execute(w(i))
            If obj.Count > 0 Then
                s = obj.Item(0).Value
                w(i - 1) = w(i - 1) & s
                w(i) = Mid(w(i), Len(s) + 1)
            End If
        Next
    End With

 End Sub

 だけど、補正後、２行目が４文字。だから３行目に単独に　こ　を配置せず

 あいうえお、
 かきくけこ

 このようにしたいということなら、さらに少しひねらなきゃいけない（ものすごく面倒になりそう）けど、そこはどう？

 (ぶらっと)

素直に一文字ずつ確認しています（マナ）

 ]を禁則文字に指定する方法がわかりませんでしたので、ちょっと不恰好です。どなたか教えてください。

 Sub test()
    Dim s1 As String, s2 As String, tmp As String
    Dim i As Long, cnt As Long
    Dim v

    s1 = Range("A1").Text

    For i = 1 To Len(s1)
        tmp = Mid(s1, i, 1)
        If tmp <> vbLf Then
            cnt = cnt + 1
            If cnt >= 6 Then
                If Not tmp Like "[),。、]" And Not tmp Like "[]]" Then
                    s2 = s2 & vbLf
                    cnt = 1
                End If
            End If
        Else
            cnt = 0
        End If
        s2 = s2 & tmp
    Next

    v = WorksheetFunction.Transpose(Split(s2, vbLf))

    With Range("A1").Offset(1).Resize(UBound(v))
        .NumberFormatLocal = "@"
        .Value = v
    End With

 End Sub

みなさん，いろいろと考えていただきありがとうございます。

ふらっとさんへ
なるほど。確かにその通りですね。
禁則文字で始まらないようにする，と考えた方がいいのでしょうか。

あああああ，，いいいいい

なら，

あああああ，，
いいいいい

となるとありがたいです。
よろしくお願いします。
（konkonbonbon）

 >あああああ，， 
 >いいいいい

 そうだろうねぇ。
 とりあえずは、(マナ)さんの回答のように１文字ずつのチェックで。
 ループの中の文字列連結は、データによっては処理効率が落ちて時計マークがでる場合があるので
 配列に格納してJOINという手はあるけど、オーソドックスには、この方法だね。

 自分自身の勉強のために、なんとか正規表現でと、四苦八苦しているけどパターンを考えていると
 頭の中が沸騰状態になってる、

 いずれにしても(マナ)さんの方法でどうぞ。

 (ぶらっと)

 こんな感じ？
 Option Explicit

 Sub test()
    Dim txt As String, i As Long
    txt = Range("a1").Value
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "[^\n\b]{1,5}[\b、，。]*"
        If .test(txt) Then
            For i = 0 To .Execute(txt).Count - 1
                Range("a1").Offset(i + 1).Value = .Execute(txt)(i)
            Next
        End If
    End With
 End Sub
 (seiya)

 Sample3 単独で。（パターン、どこかに抜けがあるかもしれないけど・・・）

 Sub Sample3()
    Dim s As String
    Dim w As Variant

    s = Range("A1").Value
    With CreateObject("VBSCript.RegExp")
        .Global = True
        .Pattern = "(.{5})([,|、|。]*)"
        s = .Replace(s, "$1$2" & vbLf)
    End With
    w = Split(Replace(s, vbLf & vbLf, vbLf), vbLf)
    Range("A2").Resize(UBound(w) + 1).Value = WorksheetFunction.Transpose(w)
 End Sub

 (ぶらっと)

みなさんありがとうございます。
こういう方法がありましたか…。素晴らしいの一言です。

さらに，追加で次のようにしたいときはどうしたらいいでしょうか？
条件を整理すると，
一つのセルに改行入りの文字列があり，
①５文字ずつセルに貼り付ける。
②，や。で始まらないように禁則処理を行う。
ここまでは完璧です。
さらに，
③特定の文字から始まるときのみ10文字（例えば）貼り付ける
という条件が必要となりました…

特定の文字を「特定」とするなら，（特定の文字列は先頭にしかありません。）

あああああ，，いいい
ううう
ええええええおお
特定の文字列だから長いよ

であるとすれば，

あああああ，，
いいい
ううう
えええええ
えおお
特定の文字列だから長
いよ

としたいのです。
これで多分最後のお願いです。
よろしくお願いします。
（konkonbonbon）

 こういうことなか？

 Sub test()
    Dim txt As String, i As Long
    txt = Range("a1").Value
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "(^特定[^\n]{1,8}|[^\n\b]{1,5})[\b、，。]*"
        If .test(txt) Then
            For i = 0 To .Execute(txt).Count - 1
                Range("a1").Offset(i + 1).Value = .Execute(txt)(i)
            Next
        End If
    End With
End Sub
(seiya)

 なんか、回答側がそうでるなら、この条件ではどうだ！！　と、どんどん難問にしていっている？
 (ちょっと、うがちすぎですかね？）

 いずれにしても、私のレベルでは、この条件になるとループ無しの正規表現処理は無理なので
 seiyaさんのコードをご利用くださいな。

 (ぶらっと)

みなさんありがとうございました。
やっていくうちに，「こうだったら？」と新たな条件が出てきて，
みなさんに甘えてしまいました…。

もっと勉強して，うまく処理できるようにしていきたいと思います。
ありがとうございました。
（konkonbonbon）

コメント返信：

[ 一覧(最新更新順) ]

[[20130316165550]] 『マクロでの改行を考慮した文字貼り付け』（konkonbonbon） ページの最後に飛ぶ

[[20130316165550]]　『マクロでの改行を考慮した文字貼り付け』（konkonbonbon）　ページの最後に飛ぶ