Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Professional : Access 2010)
レコードの更新(フォーマット)について
投稿日時: 18/01/30 14:12:34
投稿者: 馬車道停留所

こんにちは、
 
テーブルAのフィールドDの、レコード(下記@)を、
レコード(下記A)の表記する方法についてご教授ください。
 
@kanto100_001:kanto200_002:|東京|埼玉
        ↓
Akanto100_001(東京):kanto200_002(埼玉)
 
※例えば、kanto100_001は、グループ名で、東京は、そのグループの地域名を表しています。
※フィールドDには、平均して、5から6個、多くて30ぐらいのグループ名と、
 |(パイプ)の後に、それぞれの地域名データが入っています。
 
レコードが、長くなると、グループが、どの地域のもの分かりにくくなるので、
グループの後に、地域名を、()で括って表記させたいと言うのが趣旨です。
 
 

回答
投稿日時: 18/01/30 15:10:15
投稿者: sk

引用:
@kanto100_001:kanto200_002:|東京|埼玉
        ↓
Akanto100_001(東京):kanto200_002(埼玉)
  
※例えば、kanto100_001は、グループ名で、東京は、そのグループの地域名を表しています。

1. 標準モジュールに以下のようなプロシージャを追加する。
 
(標準モジュール)
--------------------------------------------------------------------------
Public Function fncConvertList(ByVal Expression As Variant) As Variant
On Error GoTo Err_fncConvertList
     
    Const conCodeDelimiter = ":"
    Const conNameDelimiter = "|"
     
    Dim strCodeSection As String
    Dim strNameSection As String
     
    Dim varCode As Variant
    Dim aryCodes As Variant
    Dim varName As Variant
    Dim aryNames As Variant
     
    Dim lngDivide As Long
    Dim lngCnt As Long
     
    fncConvertList = Null
     
    If IsNull(Expression) Then
        Exit Function
    End If
     
    lngDivide = InStr(1, Expression, conNameDelimiter, vbBinaryCompare)
     
    If lngDivide > 0 Then
        strCodeSection = Left(Expression, lngDivide - 1)
        strNameSection = Mid(Expression, lngDivide + 1)
    End If
     
    If strCodeSection Like ("*" & conCodeDelimiter) Then
        strCodeSection = Left(strCodeSection, Len(strCodeSection) - 1)
    End If
 
    If strNameSection Like ("*" & conNameDelimiter) Then
        strNameSection = Left(strNameSection, Len(strNameSection) - 1)
    End If
     
    aryCodes = Split(strCodeSection, conCodeDelimiter, -1, vbBinaryCompare)
    aryNames = Split(strNameSection, conNameDelimiter, -1, vbBinaryCompare)
     
    'コードの個数と名前の個数が一致しない場合はエラー値を返す
    If UBound(aryCodes) <> UBound(aryNames) Then
        fncConvertList = CVErr(10001)
        Exit Function
    End If
     
    For lngCnt = LBound(aryCodes) To UBound(aryCodes)
        aryCodes(lngCnt) = aryCodes(lngCnt) & "(" & aryNames(lngCnt) & ")"
    Next
 
    fncConvertList = Join(aryCodes, conCodeDelimiter)
 
Exit_fncConvertList:
     
    Exit Function
 
Err_fncConvertList:
     
    fncConvertList = CVErr(Err.Number)
 
End Function
--------------------------------------------------------------------------
 
引用:
テーブルAのフィールドD

2. 以下のような選択クエリを作成する。
 
( SQL ビュー)
--------------------------------------------------------------------------
SELECT [テーブルA].[フィールドD],
       fncConvertList([テーブルA].[フィールドD]) AS フィールドDの変換結果
FROM [テーブルA];
--------------------------------------------------------------------------

投稿日時: 18/01/31 12:43:21
投稿者: 馬車道停留所

skさん
 
ご丁寧にまた迅速にご回答をいただき
ありがとうございました。
 
自力ではとうていできませんでした。
 
心より感謝申し上げます。