文字列検索チェック

質問

VB6.0について質問です。
VBからデータベースのデータを読込んでそれに応じたチェックボックスを
チェックするという制御がうまくいきません。
詳細は、データは空白で区切られていて３つまでは固定された文字で送られてきます。(リンゴ バナナ オレンジ)
これだけだと以下のプログラムで済むのですがこの３つ以外に不確定の文字が
入っている場合はその他にチェックを入れたいのですが
どのようにプログラムを組めばよいですか？
チェックは複数選択可能です。

＊targetStringにデータベースからのデータが入ってきます

If InStr(targetString, "リンゴ") <> 0 Then
Chk1(0).Value = 1
Else
Chk1(0).Value = 0
End If
If InStr(targetString, "バナナ") <> 0 Then
Chk1(1).Value = 1
Else
Chk1(1).Value = 0
End If
If InStr(targetString, "オレンジ") <> 0 Then
Chk1(2).Value = 1
Else
Chk1(2).Value = 0
End If

回答No.5

noname#223623 · ベストアンサー

#1です。#2さんのコード、なかなかの力作ですね。ただ、私の意図とは少し違っているので自分でも書いてみました。VB6がないのでVBScript(WSH)ですが、私の考えはわかっていただけると思います。チェックボックスの代わりに配列で擬似的に処理しているので、適宜置き換えて読んでください。#1の対応部分をコメントで入れておきました。

'test.vbsここから
Option Explicit
dim targetString
dim myarray, item
dim Chk1
dim i

targetString = "リンゴ バナナ パイナップル オレンジ"

'チェックボックスの値をすべて0にする(既に0なら不要)
'ここでは配列で擬似的にやっているので実際は書き換えが必要
Chk1 = Array(0, 0, 0, 0)

myarray = split(targetString, " ") 'split関数で文字列を配列に分割

'ループ処理で配列の要素を順番に取り出す
for each item in myarray
WScript.echo item ' debug

'値をselect caseでチェック
select case item
'イチゴ、バナナ、オレンジだったら対応するチェックボックスの値を1にする
case "リンゴ" : Chk1(0) = 1
case "バナナ" : Chk1(1) = 1
case "オレンジ" : Chk1(2) = 1
'それ以外ならその他のチェックボックスの値を1にする
case else : Chk1(3) = 1
end select
next

'結果表示
for i = 0 to 3
WScript.echo "Chk1(" & i & ") => " & Chk1(i)
next
'test.vbsおわり

targetStringの内容をいろいろ変えて実行してもらえればなんとなくわかると思います。細かい説明をすると長くなるので書きませんが、疑問があればお答えしますので補足してください。VBで書けなくてごめんなさい。

お礼

お世話になっております。
masa_peeさんの助言を参考にしましたら無事に動きました＾＾
私なんかのためにここまで細かく説明してくださってありがとうございました！
心より感謝いたします。。。
またお知恵をお借りすることがあるかもしれませんが
そのときはよろしくお願いします。
では本当にありがとうございました。

回答No.6

noname#22222

s_husky です。

listString = "リンゴ バナナ"=>CutStr(listString, " ", I)
listString = "リンゴ,バナナ"=>CutStr(listString, ",", I)
listString = "リンゴ;バナナ"=>CutStr(listString, ";", I)

Private Sub Command1_Click()
　　Dim I　　　　　　As Integer
　　Dim intIndex　　 As Integer
　　Dim listString　 As String
　　Dim targetString As String

　　listString = "リンゴ バナナ"
　　Do
　　　　I = I + 1
　　　　targetString = CutStr(listString, " ", I)
　　　　If Len(targetString & "") > 0 Then
　　　　　　intIndex = Abs((InStr(1, targetString, "リンゴ", vbTextCompare) > 0) _
　　　　　　　　　　 + (InStr(1, targetString, "バナナ", vbTextCompare) > 0) * 2 _
　　　　　　　　　　 + (InStr(1, targetString, "オレンジ", vbTextCompare) > 0) * 3)
　　　　　　intIndex = intIndex + Abs((intIndex = 0) * 4)
　　　　　　Check1(0).Value = Check1(0).Value + Abs(intIndex = 1)
　　　　　　Check1(1).Value = Check1(1).Value + Abs(intIndex = 2)
　　　　　　Check1(2).Value = Check1(2).Value + Abs(intIndex = 3)
　　　　　　Check1(3).Value = Check1(3).Value + Abs(intIndex = 4)
　　　　　　DoEvents
　　　　End If
　　Loop Until targetString = ""
End Sub

こんなんでOKと思います。

listString = "リンゴ バナナ リンゴ "

というデータは想定していません。

お礼

ご返答ありがとうございました＞＜
やってみたのですがやはりうまくいきませんでした。
targetString = CutStr(listString, " ", I)でエラーがはしるようです。
私の力不足でご迷惑をお掛けしました＞＜
またお知恵を借りることがあるかもしれません。
そのときはどうぞよろしくお願いします。。。

回答No.4

noname#22222

s_husky です。

即答でないと役に立たないようですね！
質問者は、以下のコードを試して下さい。
そうすると、チェックボックスの値が目的通りに設定されていくのが判ると思います。
このスタイルですと、質問者のコードとの相性もいい筈です。

Check1(0)　－＞ chk1(0) と修正

Private Sub Command1_Click()
　　Dim targetString As String
　　Dim intIndex　　 As Integer

　　Do
　　　　targetString = InputBox("targetString を入力して下さい。未入力で終了です。")
　　　　If Len(targetString & "") > 0 Then
　　　　　　intIndex = Abs((InStr(1, targetString, "リンゴ", vbTextCompare) > 0) _
　　　　　　　　　　 + (InStr(1, targetString, "バナナ", vbTextCompare) > 0) * 2 _
　　　　　　　　　　 + (InStr(1, targetString, "オレンジ", vbTextCompare) > 0) * 3)
　　　　　　intIndex = intIndex + Abs((intIndex = 0) * 4)
　　　　　　intIndex = intIndex - 1
　　　　　　Check1(0).Value = Abs(intIndex = 0)
　　　　　　Check1(1).Value = Abs(intIndex = 1)
　　　　　　Check1(2).Value = Abs(intIndex = 2)
　　　　　　Check1(3).Value = Abs(intIndex = 3)
　　　　　　DoEvents
　　　　End If
　　Loop Until targetString = ""
End Sub

補足

お世話になっております。
すいません補足質問なのですが
s_huskyさんのやり方では複数チェックができないようです。
実行しましたら決まった値がintIndexに入り無限ループ状態になってしまいます。
複数検索チェックを実現したいのですがお知恵をおかしください＞＜

回答No.3

noname#22222

s_husky です。

ちょっと、理解しにくいコードと思いますので補足です。

? (1=1)
True

? (1=0)
False

です。

Ｔｒｕｅ=-1 です。
Ｆａｌｓｅ=0 です。

つまり、論理式を利用しています。

※この論理式の利用は、覚えた方がいいですよ！
※If-Then文が追放できます。

回答No.2

noname#22222

うーん!
おじさんは、ちょっと違うやり方をします。
No1さんの答えの具体例です。

GetIndexNumber の戻り値 - 1 がチェクボックスのインデックスです！
Command1_Click()　を試せば、 1、２、３、４　と表示される筈です。
ですから、-1すれば、チェックボックスのインデックスに一致します。

Private Sub Command1_Click()
　　Dim I　　　 As Integer
　　Dim N　　　 As Integer
　　Dim strSend As String
　　Dim strWord As String

　　strSend = "リンゴ バナナ オレンジ その他"
　　strWord = "Start"
　　Do
　　　　I = I + 1
　　　　strWord = CutStr(strSend, " ", I)
　　　　If strWord <> "" Then
　　　　　　MsgBox GetIndexNumber("リンゴ バナナ オレンジ", strWord)
　　　　Else
　　　　　　Exit Do
　　　　End If
　　Loop Until (0)
End Sub

Public Function GetIndexNumber(ByVal strList As String, ByVal strWord As String) As Integer
　　Dim N As Integer

　　N = Abs((strWord = "リンゴ") + (strWord = "バナナ") * 2 + (strWord = "オレンジ") * 3)
　　GetIndexNumber = N + Abs((N = 0) * 4)
End Function

Public Function CutStr(ByVal Text As String, _
　　　　　　　　　　　 ByVal Separator As String, _
　　　　　　　　　　　 ByVal N As Integer) As String
　　Dim strDatas() As String

　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　CutStr = strDatas(N * Abs((N <= UBound(strDatas))))
End Function

回答No.1

noname#223623

えーと、InStrを使うのはまずいと思います。targetStringが"イチゴ 台湾バナナ オレンジ"でも、バナナにチェックがつきますよね。なので、ここは配列に分割して、各要素の値をチェックしたほうがいいと思います。考え方としては
　* チェックボックスの値をすべて0にする(既に0なら不要)
　* split関数で文字列を配列に分割
　* ループ処理で配列の要素を順番に取り出す
　* 値をselect caseでチェック
　* イチゴ、バナナ、オレンジだったら対応するチェックボックスの値を1にする
　* それ以外ならその他のチェックボックスの値を1にする
でいいと思います。

ここからは余談です。怒らないで聞いてくださいね。過去の質問をいくつか拝見しましたが、あまりお礼や補足を書いていないようですね。回答する立場から言うと、リアクションのない人には答えようか迷うことがあります。感情的な理由がないとは言いませんが、それよりも質問者の技術レベルがわからないので答えにくいんです。もちろん、書くか書かないかは質問者さんの自由ですので強制は致しませんが、良い回答を期待するならなるべく書いた方がいいと思いますよ。