TABLE1のフィールドがID,ジャンル、ワードだとします。データは下記のようになります。

001,G1,犬 猫 馬
002,G1,犬 猫
003,G2,猫 馬
004,G2,犬 猫

ジャンルがG1かつ、「犬」というワードが入っているワードを削除したいと思います。ただし、「犬」のみを削除したいです。以下のように書きかえたいと思っています。
001,G1,猫 馬
002,G1,猫
003,G2,猫 馬
004,G2,犬 猫
Access2003,VBAで行うとしたらどのようにしたら上記の事が実現可能でしょうか?

回答の条件
  • 1人2回まで
  • 登録:2009/10/18 04:19:19
  • 終了:2009/10/25 04:20:02

回答(3件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912009/10/18 10:55:29

ポイント27pt

VBS でなくとも クエリでできるとは思いますが、VBSでやる例です。

(内容は SQL を実行するだけですが。)


「*犬」というパターンを避けるために、面倒ですがパターンを4つに分けてみました。

(Replaceを重ねればひとつにもできそうですが、この方がわかりやすいと思いましたので分けました。)


また例示のスペースが全角になっているのでコードもそのようになっています。

半角の場合は変更してください。

Sub Update_RemoveDOG()
    DoCmd.SetWarnings WarningsOn:=False

    Dim SQL As String
'// 途中にある場合
    SQL = "UPDATE TABLE1 SET ワード = Replace( ワード, "" 犬 "","" "" ) WHERE ワード LIKE ""* 犬 *"""
    DoCmd.RunSQL SQL
    
'// 最後にある場合
    SQL = "UPDATE TABLE1 SET ワード = Replace( ワード, "" 犬"","""" ) WHERE ワード LIKE ""* 犬"""
    DoCmd.RunSQL SQL

'// 最初にある場合
    SQL = "UPDATE TABLE1 SET ワード = Replace( ワード, ""犬 "","""" ) WHERE ワード LIKE ""犬 *"""
    DoCmd.RunSQL SQL

'// 犬だけの場合
    SQL = "UPDATE TABLE1 SET ワード = Replace( ワード, ""犬"","""" ) WHERE ワード=""犬"""
    DoCmd.RunSQL SQL

    DoCmd.SetWarnings WarningsOn:=True
End Sub
id:tama-jp No.2

たまたん回答回数36ベストアンサー獲得回数112009/10/18 11:00:38

ポイント27pt

DAOですがこんなのでよろしいでしょうか。

ワードを一度” ”(スペース)区切りで配列化し、

犬という単語のみをのぞいてもう一度、連結し直して

その単語をアップデートする方法です。

全角スペースで区切られていることが条件で書いてます。

あと、エラー処理などは、書いてませんのであしからず。

Sub TEST01()
    Dim DB As DAO.Database
    Dim RS As DAO.Recordset
    Dim SQL As String
    Dim i As Integer

    Dim strTemp() As String

    Dim strData As String

    SQL = "SELECT ID , ジャンル ,ワード FROM TABLE1 WHERE ジャンル = ""G1""  AND ワード LIKE ""*犬*"" ;"
  
     Set DB = CurrentDb
     Set RS = DB.OpenRecordset(SQL)

        Do Until RS.EOF
            strData = ""
            strTemp = Split(RS!ワード, " ")
            
            For i = 0 To UBound(strTemp)
                If strTemp(i) <> "犬" Then
                    strData = strData & strTemp(i) & " "
                End If
            Next i
        
             strData = Trim(strData)
             
             Call updateDB(RS!ID, RS!ジャンル, strData)
             
             RS.MoveNext
        Loop
    Set RS = Nothing
    Set DB = Nothing

End Sub

Sub updateDB(strID As String, strジャンル As String, strワード As String)
         Dim DB As DAO.Database
         Dim SQL As String
   
         Set DB = CurrentDb
        
   
         SQL = "UPDATE TABLE1 SET ジャンル = """ & strジャンル & _
               """ , ワード  = """ & strワード & """ WHERE ID = """ & strID & """   "
         
         DB.Execute (SQL)
End Sub

VB6.0などで正規表現が簡単に使えない場合に使いますが、

もし、正規表現が使えるならそれを使った方がいいです。

ちなみに、IEモジュールを使えば正規表現は使えますが、

IEのバージョンなどによりうまく動くかどうかはわかりません。

id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912009/10/18 18:05:11

ポイント26pt

最初にコメントのような説明があったほうがよいかと思いますが、ジャンルとワードを指定した処理の例です。

少しはVBAらしくしてみました。

Option Compare Database

Const SpaceW = " "
Const SpaceS = " "

'---------------------------------------------------------
Sub main()
'---------------------------------------------------------
    RemoveWordFromTable "Table1", "G1", "犬"
End Sub

'---------------------------------------------------------
Sub RemoveWordFromTable(tableName As String, groupName As String, wordName As String)
'---------------------------------------------------------
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    Set db = CurrentDb()
    Dim Sql As String
    Sql = "SELECT * FROM " & tableName & " WHERE ジャンル=""" & groupName & """ AND ワード LIKE ""*" & wordName & "*"""
    Set rs = db.OpenRecordset(Sql, dbOpenDynaset)
   
    Do Until rs.EOF
        rs.Edit
        rs!ワード = RemoveWord(rs!ワード, wordName)
        rs.Update
        rs.MoveNext
    Loop
        
    rs.Close: Set rs = Nothing
    db.Close: Set db = Nothing
End Sub

'---------------------------------------------------------
Function RemoveWord(srcData, searchWord) As String
'---------------------------------------------------------
'// いったん半角スペースに置換
    RemoveWord = SpaceS & Replace(srcData, SpaceW, SpaceS)
    RemoveWord = Replace(RemoveWord, SpaceS & searchWord, SpaceS)
    
'// 連続するスペースを置換
    Dim srcLen As Long
    Do
        srcLen = Len(srcData)
        srcData = Replace(srcData, SpaceS & SpaceS, SpaceS)
    Loop While Len(srcData) <> srcLen

'// 前後のスペースの除去 & スペースの全角置換
    RemoveWord = Trim(Replace(RemoveWord, SpaceS, SpaceW))
End Function

フォームでボタンクリックした際に、main のように RemoveWordFromTable を呼べば希望の処理になると思います。

その際に、フォームの値を第2引数と、第3引数として渡せばよいでしょう。


フォームが空のときなどのエラー処理が必要な場合は追加してみてください。

  • id:ken3memo
    DBはVBAでADOを使用して居ますか?、それともDAO?
    ※人によって、まだ好みが違うので、過去のシステムの修正時には意外と盲点だったり。
    http://msdn.microsoft.com/ja-jp/library/cc948692.aspx
    ADO接続のSQLのLike演算子が少々違うので。
    http://macoto.blog.so-net.ne.jp/2009-04-14
    まぁ、SQL文1発よりも、レコードセットを回して1つ1つ調べて.Updateのほうが処理のイメージつかめそうですが。
  • id:ken3memo
    SQL一発で更新は、ワードの前後のスペースもあるので難しいかなぁ。(SQLに詳しい人に笑われそうだけど)
    単純にやると、
    001,G1,犬 猫 馬

    001,G1, 猫 馬
    になりそう(笑)
    すいません、追加質問で、ワードの区切りには必ず空白があるんですか?
    VBAでADO,DAOどちらを使用しているかをあわせてコメントに書いてもらえると、回答がつきやすいと思ったり。
    ※個人的にはプロのSQLで一発変換も見てみたいけど。
  • id:t-wata
    たとえば、G1で「犬」を削除する場合、テーブルに「柴犬」とか「犬吠崎」とか犬のつくキーワードが他にも入っている可能性を考慮する必要はあるんでしょうか?
    もしそれまで考慮するなら結構面倒ですね。
    できるならテーブルを正規化した方がいいと思います。下みたいに。

    001,G1,犬
    001,G1,猫
    001,G1,馬
    002,G1,犬
    002,G1,猫


  • id:Mook
    回答中でReplace を使用しましたが、Access 2000 では使用できないようなので、
    使用しているバージョンが2003以降でない場合は、コメントください。

    VBA の標準関数を使用することで対応できます。
  • id:akaired
    DAOを利用しています。ワードの区切りには必ずスペースがあります。ちなみに「柴犬」などのワードを考慮する必要は今回ありません。使用しているAccessは2003になります。
    ちなみに、やりたい事はフォームにワードとジャンルのテキストボックスを配置。入力されたワードとジャンルをキーに入力されたワードを選択したジャンルから削除したいと思っています。
  • id:Mook
    すいませんジャンルを無視していました。

    SQL の後ろに
    & " AND ジャンル = ""G1"""
    を追加してください。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません