文字数を越えた文字列を削除するには？

質問

いつもお世話になっております。また行き詰ってしまいました。
ご助言頂きたくお願い致します。

Ａ列とＢ列にデータが入っていて、Ｂ列には２つのパターンの文字が入っています。

一つは、前の１０文字が必ず半角（英字+９ケタの数字）その後は全角のスペースの後に
全角の文字が並びます。（全角の文字数は不規則）
例１：A123456789　あいうえおかきくけこさしすせそ

もう一つは頭からすべて全角文字
例２：あいうえおかきくけこさしすせそたちつてと

問題になっている部分は、このＢ列に入っているデータを頭から
全角１５文字以内、半角なら３０文字以内に収める
という所です。

例１だと、
A123456789　あいうえおかきくけこさしすせそ
→A123456789　あいうえおかきくけ（半角10文字+全角10文字）

例２だと
あいうえおかきくけこさしすせそたちつてと
→あいうえおかきくけこさしすせそ（全角15文字）

下記のようなマクロを作ってみたのですが2つのパターンに対応する為にはどうすればよいでしょうか？

Const col1 As String = "B"
Dim idx1 As Long
Dim myStr1 As String
With ActiveSheet
For idx1 = .Cells(65536, col1).End(xlUp).Row To 1 Step -1
myStr1 = Cells(idx1, "B")
If .Cells(idx1, "B").Value = "" Then
Else
Cells(idx1, "B") = Left(myStr1, 15)
End If
Next idx1
End With

以上、宜しくお願い致します。
環境：windowsXP　Excel2003

回答No.2

tom04 · ベストアンサー

こんばんは！
せっかくコードをお考えのようですが、一例です。

バイト数で追いかけてみてはどうでしょうか？
半角の場合は1バイト・全角の場合は2バイトとなるのを利用します。

Sub Sample1()
Dim i As Long, k As Long, cnt As Long, myStr As String
For i = 1 To Cells(Rows.Count, "B").End(xlUp).Row
If LenB(StrConv(Cells(i, "B"), vbFromUnicode)) > 30 Then
For k = 1 To Len(Cells(i, "B"))
cnt = cnt + LenB(StrConv(Mid(Cells(i, "B"), k, 1), vbFromUnicode))
myStr = myStr & Mid(Cells(i, "B"), k, 1)
If cnt >= 30 Then
Exit For
End If
Next k
Cells(i, "B") = myStr
cnt = 0
myStr = ""
End If
Next i
End Sub

※　半角文字が奇数の場合が問題ですが、今回のご質問に関しては
9文字の半角英数＋全角の空白　があるというコトですので大丈夫だと思います。
（半角の空白の場合は1文字多く表示されてしまいます）m（_ _）m

お礼

お教えいただきありがとうございます。
無事狙い通りの動きが出来て先に進む事が出来ました。
大変助かりました。本当にありがとうございました！

回答No.1

srx-atx

Mid(myStr1,2,1)で左から2番目の数字を抜いて、
InStrとIfでそれが数字かどうか判定させ、
数字なら例1、数字でないなら例2に対応するように
つくればいいんじゃないでしょうか？

お礼

教え頂きありがとうございます。
問題解決までまだまだ力が足りずお恥ずかしい限りです。
一番に回答していただきありがとうございました。