Q&A
Rc1,Rc2,Rc3,Err_flg は、どのように定義していますか。
それが、判らないと、関数化できません。
実現したいこと
If文の中の同じ処理を簡潔に書きたい
発生している問題・分からないこと
If文の中に同じコードがあるのでcall文で呼び出してコードを綺麗にしたいのですが上手く出来ません。
引数を使うことはわかってるのですが、上手く呼び出せない。
該当のソースコード
Set Rc1 = CurrentDb.OpenRecordset("T_会場") Set Rc2 = CurrentDb.OpenRecordset("SELECT * FROM WK_会場マスター ORDER BY 会場コード") Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト") If Rc2.RecordCount > 0 Then Do Until Rc2.EOF = True Err_flg = False If Len(Trim(Rc2![受験地区])) > 5 Then Rc3.AddNew Rc3![試験実施日] = Rc2![試験実施日] Rc3![会場コード] = Rc2![会場コード] Rc3![項目名] = "受験地区" Rc3![項目内容] = Rc2![受験地区] Rc3![文字数] = Len(Rc2![受験地区]) Rc3.Update Err_flg = True End If If Len(Trim(Rc2![会場名])) > 30 Then Rc3.AddNew Rc3![試験実施日] = Rc2![試験実施日] Rc3![会場コード] = Rc2![会場コード] Rc3![項目名] = "会場名" Rc3![項目内容] = Rc2![会場名] Rc3![文字数] = Len(Rc2![会場名]) Rc3.Update Err_flg = True End If If Len(Trim(Rc2![会場名略])) > 20 Then Rc3.AddNew Rc3![試験実施日] = Rc2![試験実施日] Rc3![会場コード] = Rc2![会場コード] Rc3![項目名] = "会場名略" Rc3![項目内容] = Rc2![会場名略] Rc3![文字数] = Len(Rc2![会場名略]) Rc3.Update Err_flg = True End If If Len(Trim(Rc2![所在地])) > 30 Then Rc3.AddNew Rc3![試験実施日] = Rc2![試験実施日] Rc3![会場コード] = Rc2![会場コード] Rc3![項目名] = "所在地" Rc3![項目内容] = Rc2![所在地] Rc3![文字数] = Len(Rc2![所在地]) Rc3.Update Err_flg = True End If If Len(Trim(Rc2![交通手段1])) > 30 Then Rc3.AddNew Rc3![試験実施日] = Rc2![試験実施日] Rc3![会場コード] = Rc2![会場コード] Rc3![項目名] = "交通手段1" Rc3![項目内容] = Rc2![交通手段1] Rc3![文字数] = Len(Rc2![交通手段1]) Rc3.Update Err_flg = True End If If Len(Trim(Rc2![交通手段2])) > 30 Then Rc3.AddNew Rc3![試験実施日] = Rc2![試験実施日] Rc3![会場コード] = Rc2![会場コード] Rc3![項目名] = "交通手段2" Rc3![項目内容] = Rc2![交通手段2] Rc3![文字数] = Len(Rc2![交通手段2]) Rc3.Update Err_flg = True End If If Len(Trim(Rc2![交通手段3])) > 30 Then Rc3.AddNew Rc3![試験実施日] = Rc2![試験実施日] Rc3![会場コード] = Rc2![会場コード] Rc3![項目名] = "交通手段3" Rc3![項目内容] = Rc2![交通手段3] Rc3![文字数] = Len(Rc2![交通手段3]) Rc3.Update Err_flg = True End If ' If Err_flg = False Then RC1.AddNew RC1![会場コード] = Rc2![会場コード] RC1![受験地] = Rc2![受験地区] 'RC1![場] = "不使用項目" RC1![会場名] = StrConv(Rc2![会場名], vbWide) RC1![会場名略] = StrConv(Rc2![会場名略], vbWide) RC1![所在地] = StrConv(Rc2![所在地], vbWide) RC1![交通手段1] = StrConv(Rc2![交通手段1], vbWide) RC1![交通手段2] = StrConv(Rc2![交通手段2], vbWide) RC1![交通手段3] = StrConv(Rc2![交通手段3], vbWide) RC1.Update ' End If Rc2.MoveNext Loop End If End Function
試したこと・調べたこと
- teratailやGoogle等で検索した
- ソースコードを自分なりに変更した
- 知人に聞いた
- その他
上記の詳細・結果
Functionプロシージャに渡す値を変えて、繰り返す処理にしたいが引数が上手く渡せなかった。
補足
Function 会場データインポート(WK_会場)
Dim XLAPP As Object Dim varFLName As Variant Dim FLName As String Dim Rc1 As Recordset Dim Rc2 As Recordset Dim Rc3 As Recordset Dim SQL As String Dim MsgTitle As String Dim FilePath As String Dim WK_ROW As Integer Dim ST_ROW As Integer Dim WK_COL As Integer Dim WK_COL2 As Integer Dim Str_SQL As String Dim Err_flg As Boolean Dim 会場データ As String
'エラーリスト作成
'WK_会場マスター→T_会場へ
Set Rc1 = CurrentDb.OpenRecordset("T_会場")
Set Rc2 = CurrentDb.OpenRecordset("SELECT * FROM WK_会場マスター ORDER BY 会場コード")
Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト")
If Rc2.RecordCount > 0 Then Do Until Rc2.EOF = True Err_flg = False If Len(Trim(Rc2![受験地区])) > 5 Then 会場データ = "Rc2[受験地区]" Call エラーデータインポート(会場データ) End If If Len(Trim(Rc2![会場名])) > 30 Then 会場データ = "Rc2[会場名]" Call エラーデータインポート(会場データ) End If If Len(Trim(Rc2![会場名略])) > 20 Then 会場データ = "Rc2[会場名略]" Call エラーデータインポート(会場データ) End If If Len(Trim(Rc2![所在地])) > 30 Then 会場データ = "Rc2[所在地]" Call エラーデータインポート(会場データ) End If If Len(Trim(Rc2![交通手段1])) > 30 Then 会場データ = "Rc2[交通手段1]" Call エラーデータインポート(会場データ) End If If Len(Trim(Rc2![交通手段2])) > 30 Then 会場データ = "Rc2[交通手段2]" Call エラーデータインポート(会場データ) End If If Len(Trim(Rc2![交通手段3])) > 30 Then 会場データ = "Rc2[交通手段3]" Call エラーデータインポート(会場データ) End If
' If Err_flg = False Then
Rc1.AddNew Rc1![会場コード] = Rc2![会場コード] Rc1![受験地] = Rc2![受験地区] 'RC1![場] = "不使用項目" Rc1![会場名] = StrConv(Rc2![会場名], vbWide) Rc1![会場名略] = StrConv(Rc2![会場名略], vbWide) Rc1![所在地] = StrConv(Rc2![所在地], vbWide) Rc1![交通手段1] = StrConv(Rc2![交通手段1], vbWide) Rc1![交通手段2] = StrConv(Rc2![交通手段2], vbWide) Rc1![交通手段3] = StrConv(Rc2![交通手段3], vbWide) Rc1.Update
' End If
Rc2.MoveNext Loop End If
Exit_会場データインポート:
'Set DB = Nothing Set Rc1 = Nothing Set Rc2 = Nothing Set Rc3 = Nothing Set XLAPP = Nothing Set XLWRKBK = Nothing Set XLWRKSH = Nothing Exit Function
Err_会場データインポート:
'エクセルのフリーズ防止 If XLAPP Is Nothing Then Else XLAPP.Quit Set XLAPP = Nothing End If MsgBox "システムエラー 担当者に連絡して下さい。" & vbCrLf & Err.Description, vbOKOnly + vbCritical, MsgTitle Resume Exit_会場データインポート
End Function
'Callで呼び出し
Public Function エラーデータインポート(Optional 会場データ As String)
Dim Err_flg As Boolean If Err_flg = False Then: Exit Function
Set Rc2 = CurrentDb.OpenRecordset("SELECT * FROM WK_会場マスター ORDER BY 会場コード")
Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト")
Rc3.AddNew Rc3![試験実施日] = Rc2![試験実施日] Rc3![会場コード] = Rc2![会場コード] Rc3![項目名] = "会場データ" Rc3![項目内容] = Rc2!["会場データ"] Rc3![文字数] = Len(Rc2!["会場データ"]) Rc3.Update Err_flg = True
End Function
Public Function Err_flg() As Boolean
Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト") If Rc3.RecordCount > 0 Then Err_flg = True Else Err_flg = False End If
End Function
> Functionプロシージャに渡す値を変えて、繰り返す処理にしたいが引数が上手く渡せなかった。
ここを質問文に追記して下さい。
内容からは、recordsetをパラメータにすれば良さそうに思います。
タイトルではなく、作成したけど駄目だったコードを質問本文に追記して下さい
どのように纏めることで、簡潔にされようとしているのか不明なので。
ちょっと見にくいかもしれませんがよろしくお願いいたします。
> Public Function エラーデータインポート(Optional 会場データ As String)
の内容は単に作っただけで、共通化の考慮がされていません。どのように共通化されようとしていますか？
当方で共通化を考えてみましたが簡潔にはなりません（全体のコードはそんなに減らない）でしたので。
項目名と項目内容と文字数が各々変わってくるのでそこを会場データに変えて共通化をしようとしました。
フィールドの参照を項目名で行うという事ですね。
そうです。
回答3件
0
「評価対象となるフィールドの名前」と「値の文字列長の上限値」の組み合わせを、連想配列（もしくはそれらの組み合わせをレコードとして格納したテーブル）で表現した上、それらの組み合わせを順次参照なさればよろしいのではないかと。
vba
1Sub Test1() 2 3 Dim objDic As Object 4 5 Set objDic = CreateObject("Scripting.Dictionary") 6 7 With objDic 8 .Add "受験地区", 5 9 .Add "会場名", 30 10 .Add "会場名略", 20 11 .Add "所在地", 30 12 .Add "交通手段1", 30 13 .Add "交通手段2", 30 14 .Add "交通手段3", 30 15 End With 16 17 Dim db As DAO.Database 18 Dim rs1 As DAO.Recordset 19 Dim rs2 As DAO.Recordset 20 Dim rs3 As DAO.Recordset 21 Dim fld As DAO.Field 22 Dim Err_flg As Boolean 23 Dim varKey As Variant 24 25 Set db = CurrentDb 26 27 Set rs1 = db.OpenRecordset("T_会場", dbOpenDynaset) 28 Set rs2 = db.OpenRecordset("SELECT * FROM WK_会場マスター ORDER BY 会場コード", dbOpenDynaset) 29 Set rs3 = db.OpenRecordset("T_会場エラーリスト", dbOpenDynaset) 30 31 Do Until rs2.EOF = True 32 Err_flg = False 33 34 For Each varKey In objDic 35 Set fld = rs2.Fields(varKey) 36 If Len(Trim(fld.Value)) > objDic.Item(varKey) Then 37 rs3.AddNew 38 rs3![試験実施日].Value = rs2![試験実施日].Value 39 rs3![会場コード].Value = rs2![会場コード].Value 40 rs3![項目名].Value = fld.Name 41 rs3![項目内容].Value = fld.Value 42 rs3![文字数].Value = Len(fld.Value) 43 rs3.Update 44 Err_flg = True 45 End If 46 Set fld = Nothing 47 Next 48 49 If Err_flg = False Then 50 rs1.AddNew 51 rs1![会場コード].Value = rs2![会場コード].Value 52 rs1![受験地].Value = Trim(rs2![受験地区].Value) 53 rs1![会場名].Value = StrConv(Trim(rs2![会場名].Value), vbWide) 54 rs1![会場名略].Value = StrConv(Trim(rs2![会場名略].Value), vbWide) 55 rs1![所在地].Value = StrConv(Trim(rs2![所在地].Value), vbWide) 56 rs1![交通手段1].Value = StrConv(Trim(rs2![交通手段1].Value), vbWide) 57 rs1![交通手段2].Value = StrConv(Trim(rs2![交通手段2].Value), vbWide) 58 rs1![交通手段3].Value = StrConv(Trim(rs2![交通手段3].Value), vbWide) 59 rs1.Update 60 End If 61 62 rs2.MoveNext 63 Loop 64 65 Set objDic = Nothing 66 67 Set rs3 = Nothing 68 Set rs2 = Nothing 69 Set rs1 = Nothing 70 Set db = Nothing 71 72End Sub
投稿2024/04/10 08:47
総合スコア751
今回の場合は基本的に「あるフィールドの値の長さが一定の上限値を超えているか」という条件のみを繰り返し評価するだけなので上記のサンプルのような形でもよいと思いますが、それ以外の条件と組み合わせて評価する必要がある場合は、全てのパラメータ条件を網羅的に格納したテーブルを別途設けた方がよいかも知れません。
0
ベストアンサー
コードの簡略化について一部記述してみました。
ポイントとしては、項目の参照をFieldsコレクションによる名称参照にしたことです。
VBA
1Public Function 会場データインポート(WK_会場) 2 Dim Rc1 As Recordset, Rc2 As Recordset, Rc3 As Recordset 3 Dim Err_flg As Boolean 4 5 Set Rc1 = CurrentDb.OpenRecordset("T_会場") 6 Set Rc2 = CurrentDb.OpenRecordset("SELECT * FROM WK_会場マスター ORDER BY 会場コード") 7 Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト") 8 9 If Rc2.RecordCount > 0 Then 10 Do Until Rc2.EOF = True 11 12 Err_flg = False 13 14 If Len(Trim(Rc2![受験地区])) > 5 Then 15 Err_flg = True: Call エラーデータインポート("受験地区", Rc2, Rc3) 16 End If 17 18 If Len(Trim(Rc2![会場名])) > 30 Then 19 Err_flg = True: Call エラーデータインポート("会場名", Rc2, Rc3) 20 End If 21 22 If Len(Trim(Rc2![会場名略])) > 20 Then 23 Err_flg = True: Call エラーデータインポート("会場名略", Rc2, Rc3) 24 End If 25 26 If Len(Trim(Rc2![所在地])) > 30 Then 27 Err_flg = True: Call エラーデータインポート("所在地", Rc2, Rc3) 28 End If 29 30 If Len(Trim(Rc2![交通手段1])) > 30 Then 31 Err_flg = True: Call エラーデータインポート("交通手段1", Rc2, Rc3) 32 End If 33 34 If Len(Trim(Rc2![交通手段2])) > 30 Then 35 Err_flg = True: Call エラーデータインポート("交通手段2", Rc2, Rc3) 36 End If 37 38 If Len(Trim(Rc2![交通手段3])) > 30 Then 39 Err_flg = True: Call エラーデータインポート("交通手段3", Rc2, Rc3) 40 End If 41 If Err_flg = False Then 42 Rc1.AddNew 43 Rc1![会場コード] = Rc2![会場コード] 44 Rc1![受験地] = Rc2![受験地区] 45 'RC1![場] = "不使用項目" 46 Rc1![会場名] = StrConv(Rc2![会場名], vbWide) 47 Rc1![会場名略] = StrConv(Rc2![会場名略], vbWide) 48 Rc1![所在地] = StrConv(Rc2![所在地], vbWide) 49 Rc1![交通手段1] = StrConv(Rc2![交通手段1], vbWide) 50 Rc1![交通手段2] = StrConv(Rc2![交通手段2], vbWide) 51 Rc1![交通手段3] = StrConv(Rc2![交通手段3], vbWide) 52 Rc1.Update 53 End If 54 55 Rc2.MoveNext 56 Loop 57 End If 58End Function
VBA
1Public Sub エラーデータインポート(会場データ As String, Rc2 As Recordset, Rc3 As Recordset) 2 Rc3.AddNew 3 Rc3![試験実施日] = Rc2![試験実施日] 4 Rc3![会場コード] = Rc2![会場コード] 5 Rc3![項目名] = 会場データ 6 Rc3![項目内容] = Rc2!Fields(会場データ) 7 Rc3![文字数] = Len(Rc2!Fields(会場データ)) 8 Rc3.Update 9End Sub
投稿2024/04/10 08:10
編集2024/04/10 08:33総合スコア25195
0
コードを綺麗にしたいのですが
効率重視なら、以下の様なクエリーのみでも可能です。
・会場登録エラーリストクエリー
SQL
1insert into T_会場エラーリスト( 2 試験実施日, 会場コード, 項目名, 項目内容, 文字数 3) 4select * from ( 5 select 試験実施日, 会場コード, '会場名' as 項目名, 会場名 as 項目内容, len(会場名) as 文字数 6 from WK_会場マスター 7 where Len(Trim(会場名)) > 30 8 union all 9 select 試験実施日, 会場コード, '会場名略', 会場名略, len(会場名略) 10 from WK_会場マスター 11 where Len(Trim(会場名略)) > 20 12 union all 13 select 試験実施日, 会場コード, '所在地', 所在地, len(所在地) 14 from WK_会場マスター 15 where Len(Trim(所在地)) > 30 16 union all 17 select 試験実施日, 会場コード, '交通手段1', 交通手段1, len(交通手段1) 18 from WK_会場マスター 19 where Len(Trim(交通手段1)) > 30 20 union all 21 select 試験実施日, 会場コード, '交通手段2', 交通手段2, len(交通手段2) 22 from WK_会場マスター 23 where Len(Trim(交通手段2)) > 30 24 union all 25 select 試験実施日, 会場コード, '交通手段3', 交通手段3, len(交通手段3) 26 from WK_会場マスター 27 where Len(Trim(交通手段3)) > 30 28) as mrg 29;
・会場登録クエリー
SQL
1insert into T_会場( 2 会場コード, 受験地, 会場名, 会場名略, 所在地, 交通手段1, 交通手段2, 交通手段3 3) 4select 会場コード, 受験地区, StrConv(会場名, 4), StrConv(会場名略, 4), StrConv(所在地, 4), StrConv(交通手段1, 4), StrConv(交通手段2, 4), StrConv(交通手段3, 4) 5from WK_会場マスター as wk 6where not exists (select 1 from T_会場エラーリスト where 会場コード=wk.会場コード) 7;
投稿2024/04/10 05:28
編集2024/04/10 05:33総合スコア25195
あなたの回答
tips
プレビュー
