ExcelVBA セル内の文字検索

質問

1つのセルの中に文字が入力されていて、以下の条件をみたすプログラムを作りたいのですがどうすればいいか教えていただけますでしょうか。

<条件>
・カンマ(,)が右端についていること
・一番下の行はカンマがないこと

=======
11111,
22222,
33333,
4444
=======

使用環境：Excel2003

回答No.3

mu2011 · ベストアンサー

一例です。
デー範囲やエラー検出時の振舞等が不明でしたので、データ範囲をＡ列、エラー時は継続するようにしています。
Split関数で改行コードで配列化して各最終文字列を判定しています。

Sub sample()
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i, "A") <> "" Then
a = Split(Cells(i, "A"), Chr(10))
For j = LBound(a) To UBound(a)
If j < UBound(a) Then
If Right(a(j), 1) <> "," Then
MsgBox "カンマなし:" & Cells(i, "A").Address(0, 0)
Exit For
End If
Else
If Right(a(j), 1) = "," Then
MsgBox "カンマあり:" & Cells(i, "A").Address(0, 0)
End If
End If
Next
End If
Next
End Sub

回答No.2

imogasi

何がしたいか、はっきりしない。表現力を磨いて。
検索ということは
同じ列でセルの文字列の最後がカンマであるセルから、終わりがカンマでないセル１つまでを、条件に合うものとして捜したいのか。
そして見つかったらシート上でどうするのか？順次セル範囲を選択するとかの方法（ニーズ）もあるだろう。
１セルに１文字列としてまとめて表示するニーズもあるだろう。
それと複数の列を問題にするのか、１列だけ問題にするのかも書いてない。
プログラムをする人は、疑問が起こりそうな、局面を予想できなくては、バグの多いものになると思うよ。
ーーー
例えば下記のようなことか。B列にまとめて表示している。
例データ
A列　A1:A10
42,
32,
12 42, 32, 12
4,
5,
23,
42 4, 5, 23, 42
12,
3,
20 12, 3, 20
ーー
Sub test01()
Dim d(20)
r = Range("A65536").End(xlUp).Row
MsgBox r
j = 1
For i = 1 To r
X = Cells(i, "A")
If Right(X, 1) = "," Then
'MsgBox "カンマあり " & X
d(j) = X
j = j + 1
Else
d(j) = X
'MsgBox "カンマなし " & X
Cells(i, "B") = Join(d)
Erase d
j = 1
End If
Next i
End Sub
最後の行はカンマ無しの数字文字列と仮定。
そうでない場合は、手当て（コードの追加）が必要。
配列に関して
Sub test02()
ReDim d(0)
r = Range("A65536").End(xlUp).Row
MsgBox r
j = 1
For i = 1 To r
X = Cells(i, "A")
If Right(X, 1) = "," Then
'MsgBox "カンマあり " & X
ReDim Preserve d(j + 1)
d(j) = X
j = j + 1
Else
ReDim Preserve d(j + 1)
d(j) = X
'MsgBox "カンマなし " & X
Cells(i, "B") = Join(d)
Erase d
j = 1
End If
Next i
End Sub
が良いのかも。

回答No.1

Siegrune

>1つのセルの中に文字が入力されていて
>・一番下の行はカンマがないこと
ということですので、１セル内に複数行ある前提で書きます。

>以下の条件をみたすプログラム
何をしたいのでしょうか？

条件を満たすかどうかは、

dim CheckStr as string
dim wk as single

dim x as single,y as single
x = 1 'チェックするセルの行
y = 2 'チェックするセルの列
CheckStr = sheets("シート名").Cells(x,y).value
dim flag as string
flag = ""
'最初と最後以外に改行文字があったとき
'（1文字目は判定しません⇒for～nextの外で判定）
'（最終文字の,も同様）
for wk = 2 to len(CheckStr) - 1
if mid(CheckStr,wk,1) = chr(13)
if mid(Checkstr,wk - 1,1) <> "," then
flag = "Error"
end if
end if
next
if mid(CheckStr,1,1) = chr(13)
and len(CheckStr) > 1 then
flag = "Error" '改行しかない場合はエラーとしていません。
end if
if mid(CheckStr,len(CheckStr),1) = "," then
flag = "Error"
end if

'さて、ここでなにをするのか？？？
if flag = "" then
'条件を満足しています。
else
'条件を満足していません。
end if

という風にして判定できます。