人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

TABLE1のフィールドがID,ジャンル、ワードだとします。データは下記のようになります。
001,G1,犬 猫 馬
002,G1,犬 猫
003,G2,猫 馬
004,G2,犬 猫

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

●質問者: akaired
●カテゴリ:コンピュータ
✍キーワード:G1 G2 VBA 「犬」 ジャンル
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● Mook
●27ポイント

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

2 ● たまたん
●27ポイント

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のバージョンなどによりうまく動くかどうかはわかりません。


3 ● Mook
●26ポイント

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

少しは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引数として渡せばよいでしょう。


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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ