[[20100415110314]] 『文字列の数字2桁毎に全角スペースを挿入したい』(怜人) ページの最後に飛ぶ

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

 

『文字列の数字2桁毎に全角スペースを挿入したい』(怜人)

お世話になります。

    [C]

 [1]  項目名
 [2]   例012345
 [3]  月98765438
 [4] 

このような感じで、C列に漢字から始まって数字で終わる文字列があります。これを

    [C]

 [1]  項目名
 [2]   例 01 23 45
 [3]  月 98 76 54 38
 [4] 

のように、漢字は頭に1文字でその直後に全角スペースを挿入、数字は2桁ずつの区切りでそれぞれ間に全角スペースを挿入したいと考えています。

文字列のパターンはC列にあるものは全て「漢字1文字+半角数字(桁数はそれぞれ違います)」です。

シートによって行数は異なりますが、どのシートも大体4〜5万行ほどで行数が多いため出来れば関数ではなくマクロで一括処理出来れば有り難いのですが…

何か良い方法はありませんでしょうか?皆様のお知恵をお借り出来れば有り難いです。どうぞよろしくお願いいたします。

(怜人)

―――

 数字の桁数が奇数の場合はどのように表示するのですか?
 (独覚)

(独覚)様

説明不足でした。ご指摘ありがとうございます。数字の桁数ですが、奇数は無く全て偶数桁です。また、Excelは2003です。よろしくお願いします。


 こんな方法で出来そうですね
 区切り位置を使ったコードです。

  Sub test()
  Dim myLen As Long, i As Long, buf(1), myAry()
  With Range(Range("C2"), Range("C2").End(xlDown))
    myLen = (Application.Evaluate("Max(Len(" & .Address & "))") - 1) / 2
    ReDim myAry(myLen)
    For i = 0 To myLen
      buf(0) = i * 2
      buf(1) = 2
      myAry(i) = buf
    Next i
    .TextToColumns Destination:=Range("C2"), DataType:=xlFixedWidth, _
                   FieldInfo:=myAry, TrailingMinusNumbers:=True
  End With
  End Sub

 (momo)

(momo)様

早速のレスありがとうございます。
ご提示いただいたコードを「例012345」と入ったセルで試してみたところ、漢字一文字(例)と数字2桁ずつ(01、23、45)に分割出来ました!ただそれぞれ別々のセルに分れてしまったので、後はこれに全角スペースを挿入してひとつのセルに戻せばいいということですね。


 あ・・・失礼しました。全角スペースを挿入なのですね。
 修正しますので時間ください。
 (momo)

 修正というか全然違うコードにしてしまいましたが
 正規表現を使ってます。

  Sub test()
  Dim tbl As Variant, i As Long
  With Range(Range("C2"), Range("C2").End(xlDown))
    tbl = .Value
    For i = 1 To UBound(tbl)
      tbl(i, 1) = SplitStrLong(tbl(i, 1), " ")
    Next i
    .Value = tbl
  End With
  End Sub

  Function SplitStrLong(ByVal 分割文字列 As Variant, 区切り文字 As String) As Variant
  Dim myReg As Object, m As Object, buf As String
  With CreateObject("VBScript.RegExp")
    .Pattern = "^[^\d]+|^\d\d"
    .Global = True
    Do
      Set myReg = .Execute(分割文字列)
      For Each m In myReg
        SplitStrLong = SplitStrLong & 区切り文字 & m.Value
        分割文字列 = Mid(分割文字列, Len(m.Value) + 1)
      Next m
    Loop While myReg.Count > 0
  End With
  SplitStrLong = Mid$(SplitStrLong, Len(区切り文字) + 1)
  End Function

 (momo)

 変換したい範囲を選択してからマクロを実行してみてください。

 Sub Test()
    Dim W_Range As Range

    For Each W_Range In Selection
        If W_Range.Value <> "" Then
            W_Range.Value = Left(W_Range, 1) & Format(Mid(W_Range, 2), WorksheetFunction.Rept(" 00", (Int(Len(W_Range.Value) - 1) / 2)))
        End If
    Next

 End Sub
 (独覚)

 (momo)様
マクロでスペースを挿入してセルの結合をさせようと悪戦苦闘しておりました。
わざわざ修正をしていただきありがとうございます。3行目ぐらいまでしか意味がわかっていませんが、考えていた通りの結果が得られました!本当にありがとうございました。

(独覚)様
 先程からありがとうございます。一括で処理を行う部分と選択した部分だけとで使い分けたかったので、範囲を自分で選んで処理出来るのはとても有り難いです。
考えていた通りの結果が得られました!本当にありがとうございました。

(怜人)


コメント返信:

[ 一覧(最新更新順) ]


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