Access 各カラムの中に半角カナが含まれているか検索

質問

いつもお世話になっております。

現在、Accessに、10テーブル、合計100カラム、データ数20万件程度入っております。
その中から、半角カナが含まれるテーブル名、カラム名を抽出したいのですが、このようなことは可能でしょうか。
条件として、1文字でも含まれておれば抽出対象としていただきたいです。

現在は、ひとつひとつEXCELに抽出し、半角カナを全角カナに変換してEXACT関数でFALSEのものを探しています。
今回、Accessをもっと有効に使いたいと思い投稿をさせていただきました。

よろしくお願いします。

回答No.2

30246kiku

解決されていましたら、スルーしてください。

抽出するだけでOKなのですか？

Access のバージョンが2000以降（2000含む）での一例となります。

mdbの全てのテーブルに対して、半角カナを含むレコードを抽出するクエリをテーブル単位で作成します。
クエリを作成し、メッセージ表示後、クエリ単位でExcel出力します。

（実行性能：結構時間かかります）
（出来上がったクエリの抽出条件が何個か、レコード数がいくつかで左右されます）
（以下関数 KCNT が何回呼び出されるかに、左右されます）

手順）
・mdbのバックアップを取ります（必須）
・mdbを起動します
・Visual Basic Editorを起動します
・参照設定で「Microsoft DAO 3.6 Object Library」が参照されていることを確認します
・標準モジュールを挿入します
・先頭１行を削除し、以下を貼り付けます

Option Compare Binary
Option Explicit

Public Function KCNT(sMoji As Variant) As Long
　Dim iRet As Long

　iRet = 0
　If (Not IsNull(sMoji)) Then
　　If (sMoji Like "*[" & ChrW(&HFF61) & "-" & ChrW(&HFF9F) & "]*") Then
　　　iRet = 1
　　End If
　End If
　KCNT = iRet
End Function

Private Function SumField(sFieldName As String) As String
　SumField = "SUM(KCNT([" & sFieldName & "])) AS '_" & sFieldName & "'"
End Function

Private Function RetFieldName(sFieldName As String) As String
　RetFieldName = Mid(Replace(sFieldName, "'", ""), 2)
End Function

Public Sub Sample1()
　Dim tdf As DAO.TableDef
　Dim clm As DAO.Field
　Dim rs As DAO.Recordset
　Dim rsField As DAO.Field
　Const Q_H As String = "Q_HKANA_"
　Dim qdf As DAO.QueryDef
　Dim sMes As String
　Dim sSql As String
　Dim sTmp As String

　On Error Resume Next

　sMes = ""
　CurrentDb.TableDefs.Refresh
　For Each tdf In CurrentDb.TableDefs
　　If ((Not tdf.Name Like "MSys*") And (Not tdf.Name Like "~TMP*")) Then
　　　sTmp = ""
　　　For Each clm In tdf.Fields
　　　　If (clm.Type = dbText) Then
　　　　　sTmp = sTmp & ", " & SumField(clm.Name)
　　　　End If
　　　Next
　　　If (Len(sTmp) > 0) Then
　　　　sSql = "SELECT " & Mid(sTmp, 3) & " FROM [" & tdf.Name & "];"
　　　　Set rs = CurrentDb.OpenRecordset(sSql, dbOpenForwardOnly)
　　　　If (Not rs.EOF) Then
　　　　　sTmp = ""
　　　　　For Each rsField In rs.Fields
　　　　　　If (Nz(rsField.Value, 0) > 0) Then
　　　　　　　sMes = sMes & tdf.Name & ", " & RetFieldName(rsField.Name) & ", " & rsField.Value & "個" & vbCrLf
　　　　　　　sTmp = sTmp & " OR (KCNT([" & RetFieldName(rsField.Name) & "]) = 1)"
　　　　　　End If
　　　　　Next
　　　　　If (Len(sTmp) > 0) Then
　　　　　　sSql = "SELECT * FROM [" & tdf.Name & "] WHERE (" & Mid(sTmp, 5) & ");"
　　　　　　sTmp = Q_H & tdf.Name
　　　　　　CurrentDb.QueryDefs.Refresh
　　　　　　CurrentDb.QueryDefs.Delete sTmp
　　　　　　CurrentDb.CreateQueryDef sTmp, sSql
　　　　　End If
　　　　End If
　　　　rs.Close
　　　　Set rs = Nothing
　　　End If
　　End If
　Next

　MsgBox sMes

　CurrentDb.QueryDefs.Refresh
　For Each qdf In CurrentDb.QueryDefs
　　If (qdf.Name Like Q_H & "*") Then
　　　DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, qdf.Name, qdf.Name & ".xls", True
　　End If
　Next
End Sub

手順続き）
・Sub/ユーザーフォームの実行（再生ボタンみたいなボタン表示をクリック）で「Sample1」を選択し、実行します。
　（カーソルが Sample1 内にあれば、即実行されます）

処理概要）

テーブルのテキスト型フィールドに対して、半角カナが何レコードあるか調べます。
テーブル名：tbl　テキスト型フィールド名：F1 , F2 の場合
SELECT SUM(KCNT([F1])) AS '_F1', SUM(KCNT([F2])) AS '_F2' FROM tbl;

関数 KCNT は、半角カナがあれば=1、なければ=0

上記抽出結果が >0 の場合、作るクエリの抽出条件として
(KCNT([フィールド名]) = 1) を作り込み
複数ある場合には、OR で連結

半角カナがないフィールドは、抽出条件に入れません

クエリを作成（テーブル名先頭に "Q_HKANA_" を付加した名前で）

メッセージボックスで、テーブル名、フィールド名、半角カナが何レコードあったか表示します。

各クエリの内容でExcel出力します。
（Excelファイル名は、クエリ名.xls）
（場所は、mdbと同じフォルダか、オプション内全般「既定のデータベースフォルダ」の所になります）
（既に同名のExcelファイルがある時、DoCmd.TransferSpreadsheet の動作の通り）

※ 作成したクエリを実行する（開く）際には、VBEは終了させておいてください。
　（VBEを起動したままでは、かなり時間がかかります）

回答No.1

temtecomai2

Access の VBA で独自の関数を作ってみました。

標準モジュールに下記のように記述して保存。
(行頭のスペースは便宜上全角スペースにしているので、コピペする場合は半角スペースに換えてください)
---- 標準モジュール ここから ----
Option Compare Binary
Option Explicit
Function ContainHankaku(aSource As String) As Boolean
　ContainHankaku = False
　If aSource Like "*[。-゜]*" Then
　　ContainHankaku = True
　End If
End Function
---- 標準モジュール ここまで ----

次にクエリのデザインビューの下段、"フィールド" のところに
Result: ContainHankaku([テーブル名]![列名])
テーブル名と列名は実際の名前を入れてください。

SQL で書けばこんな感じ。
テーブル名: tbl01
列名: m01ID, m01Name
半角チェックをする列: m01Name
とすると、
SELECT tbl01.m01ID, tbl01.m01Name, ContainHankaku([tbl01]![m01Name]) AS Result
From tbl01
ORDER BY tbl01.m01ID;