Q&A
エラーメッセージで修復するとどうなるのでしょうか？
###前提・実現したいこと
複数営業所がある会社に勤めており、
Excel VBAで郵送されてきた請求書類の情報を
各営業所でエクセルに入力するシートを作成しています。
入力シートは簡易化していますが下記の請求情報を入力します。
・請求会社名（入力規則・リスト）
・取引内容（入力規則・リスト）
・勘定科目（自動設定）
・補助科目（自動設定）
・請求金額（手入力）
郵送されてくる請求書類は毎月同じところからくるため（例外もあるが）
入力規則でリスト選択をで基本する仕様にしています。
ただし、営業所によって届く請求書類は異なるので
入力シート：A1に営業所名のリストを作成し、変更することで
請求会社名と取引内容の入力規則をValidationで変更をかけています。
同フォルダ内に下の２ファイルを入れて、外部参照データは下表の様に作成し
営業所名が変更されると、請求会社名と取引内容の変更をかけ、
取引内容が変更されると、請求会社名と取引内容に応じた勘定科目・補助科目名を
拾ってくるようにしています。
・外部参照データ.xlsx（以降、外部参照データ）
・入力シート.xlsm（以降、入力シート）
| 請求会社名 | 取引内容 | 勘定科目 | 補助科目名 | 計上営業所 |
|---|---|---|---|---|
| A列 | B列 | C列 | D列 | E列 |
文才が無いのでわかりずらいですが、これらの仕組み自体は無事でき、
動作もしているのですが、一部の営業所名にしたときだけエラーが発生してしまう状態です。
使用環境
・Windows7
・Excel 2013 64bit
###発生している問題・エラーメッセージ
エクセルを開いた直後に
「入力シート.xlsm」の一部の内容に問題が見つかりました。可能な限り内容を修復しますか？ブックの発行元が信頼できる場合は「はい」をクリックしてください。
###試したこと
問題が起きる営業所・起きない営業所があることから
入力規則へ入れ込むデータに異常があるのかなと考え
外部参照データで問題が起きる営業所の対象データだけに絞りこみ
例えば10行データあったとすると
1行だけ残し残り9行を削除し実行
問題なければ2行だけ残し、残りを削除し実行...のように
試していきましたがエラーは出たりでなかったりと、原因の追究にいたりませんでした。
私の頭では他に考えが浮かばず、
考え方自体がおかしいのかなと思い、今回質問をさせていただきました。
初歩的なことだったり、文章に不十分な点があったら大変申し訳ないのですが
教えていただけますでしょうか？
よろしくお願いいたします。
#追記
Excel
1Option Explicit 2 3 4Private Sub Worksheet_Change(ByVal TargetRange As Range) 5 6 Application.ScreenUpdating = False 7 Application.EnableEvents = False 8 9 Dim Target As Range 10 11 ml_set.setSheets 12 arrLO = setCnvTable 13 If TargetRange.Column <= 2 And TargetRange.row > 3 Then 14 15' セルを範囲指定していた場合のループ処理 16 For Each Target In TargetRange 17 18 Select Case Target.Column 19 20 Case 1 ' 相手先名が選択されたら 21 Call wsUnProtect 22 Target.Offset(, 1).Resize(, 4).ClearContents '取引内容～金額（税込）までをクリア 23 Call setCellLocked(Target.Offset(, 4), False) '金額（税込）のロック解除 24 25 Select Case Target.Value 26 Case "" '相手先名が空白だった場合リセット 27 Target.Offset(, 1).Resize(, 12).ClearContents 28 With Target.Offset(, 1).validation 29 .Delete 30 .Add Type:=xlValidateList, _ 31 Operator:=xlEqual, _ 32 Formula1:="相手先名を設定してください" 33 .InputMessage = "取引内容の先に相手先名を設定してください" 34 .ShowError = False 35 .ShowInput = True 36 End With 37 38 Case Else '相手先名が空白じゃなければ取引内容をセット 39 Call setTradeValidationRule(Target) 40 If Cells(1, 4) <> "本社" Then Target.Offset(, 7) = Cells(1, 4) 41 42 End Select 43 Call wsProtect 44 45 Case 2 ' 取引内容が選択されたら 46 47 If Target.Offset(, -1) = "" Then '相手先名が空だったら取引内容をリセット 48 Target.ClearContents 49 50 Else 51 Select Case Target.Value 52' 取引内容を空にしたら、勘定科目～支払口座名（計上営業所を除く）までをリセットする 53 Case Is = "" 54 Call setCellLocked(Target.Offset(, 3), False) 55 Target.Offset(, 1).Resize(, 5).ClearContents 56 Target.Offset(, 7).Resize(, 4).ClearContents 57 58' 取引内容をセットしたら、勘定科目～金額・支払口座名をセットする 59 Case Else 60 Target.Offset(, 1).Resize(, 3).ClearContents 61 Call setSubjects(Target) 62 If Not IsEmpty(Target.Offset(, 3).Value) Or Target.Offset(, 3).Value > 0 Then 63 Call setCellLocked(Target.Offset(, 3), True) 64 Else 65 Call setCellLocked(Target.Offset(, 3), False) 66 End If 67 68 End Select 69 End If 70 End Select 71 Next 72 73 End If 74 75 Application.EnableEvents = True 76 Application.ScreenUpdating = True 77 78End Sub 79 80Public Sub setTargetValidationRule() 81' 請求先会社名の設定 82' 83 ReDim validation(0) 84 85 Dim i1, i2, iX As Long 86 Dim office, company As String 87 88 office = wsInput.Cells(1, 4) 89 company = wsInput.Cells(1, 2) 90 91 For i1 = 2 To UBound(arrLO) 92 If company = arrLO(i1, 8) And office = arrLO(i1, 5) And arrLO(i1, 9) <> "共通" Then 93 For i2 = 0 To UBound(validation) 94 If validation(i2) = arrLO(i1, 1) Then 95 Exit For 96 ElseIf i2 = UBound(validation) Then 97 ReDim Preserve validation(iX) 98 validation(iX) = arrLO(i1, 1) 99 iX = iX + 1 100 End If 101 Next i2 102 End If 103 Next i1 104 105 If iX > 0 Then 106 Call setValidation(wsInput.Range("A4:A300"), validation, False) 107 End If 108End Sub 109 110Public Sub setTradeValidationRule(Target As Range) 111' 取引内容の設定 112 Dim validation() 113 114 Dim i1 As Long 115 Dim iX As Long 116 117 Dim office As String 118 office = wsInput.Cells(1, 4) 119 120 For i1 = 2 To UBound(arrLO) 121 If office = arrLO(i1, 5) And Target = arrLO(i1, 1) And Not IsEmpty(arrLO(i1, 2)) Then 122 ReDim Preserve validation(iX) 123 validation(iX) = arrLO(i1, 2) 124 iX = iX + 1 125 End If 126 Next i1 127 128 If iX > 0 Then 129 Call setValidation(Target.Offset(, 1), validation, False) 130 Else 131 With Target.Offset(, 1).validation 132 .Delete 133 .Add xlValidateInputOnly 134 .InputMessage = "「" & Target + "」は、取引内容が設定されていません" + vbNewLine + "取引内容は直接入力をしてください" 135 .ShowInput = True 136 .IMEMode = xlIMEModeHiragana 137 End With 138 End If 139End Sub 140 141Public Sub setValidation(Target As Range, validation, isErr As Boolean) 142' 入力規則リストの設定function 143' isErr の値で直接入力の可否を分岐する 144 145 Dim i1 As Long 146 Dim str, _ 147 inputMsg, _ 148 errMsg As String 149 150 Select Case isErr 151 Case False 152 inputMsg = "プルダウンに選択したい項目がない場合は、直接入力してください" 153 Case True 154 inputMsg = "プルダウンから選択してください" 155 errMsg = "入力できる値はプルダウンの値のみです" 156 End Select 157 158 For i1 = 0 To UBound(validation) '配列validationを「,」区切りの文字列へ変換 159 str = str + validation(i1) 160 If i1 < UBound(validation) Then str = str + "," 161 Next i1 162 163 If str = "" Then str = "取引内容が設定されていません、直接入力をしてください" 'リストの文字列が空だった場合、代替文字を代入 164 165 With Target.validation 166 .Delete 'validationを設定する場合ははじめに必ずDelete 167 .Add Type:=xlValidateList, _ 168 AlertStyle:=xlValidAlertStop, _ 169 Operator:=xlEqual, _ 170 Formula1:=str 171 .InputMessage = inputMsg 172 .ErrorMessage = errMsg 173 .ShowInput = True 174 .ShowError = isErr 175 .IMEMode = xlIMEModeHiragana 176 End With 177 178End Sub 179 180Public Function setCnvTable() 181' 外部参照データにある計上科目変換表をThisWorkbookへ取り込むコード 182' 最新更新日時をトリガーとして、Workbook内に控えてある前回の最新更新日時からアップデートがされていたら再取り込みを行う。 183' 毎回の外部参照をすると動作遅延が生じるための動作高速化処理 184 185 Dim wsCnvTable As Worksheet 186 Dim path As String 187 Dim wb As Workbook 188 Dim fName As String 189 Dim Ary 190 Dim rcLastUpDate As Date 191 Dim getLastUpDate As Date 192 193 Set wsCnvTable = Worksheets("計上科目変換表") 194 rcLastUpDate = wsCnvTable.Cells(1, 12) '控えてある最新更新日時をセット 195 196 getLastUpDate = getDateLastModified(rcLastUpDate) '現在の外部参照データファイルの最新更新日時を取得 197 198 If getLastUpDate > rcLastUpDate Then '取得した現在の更新日時 199 path = ThisWorkbook.path & "\" 200 fName = "外部参照データ.xlsx" 201 202' 同ファイルが開いていた場合はデータだけを取得し開いたままに、閉じていた場合はデータ取得後閉じる処理分岐 203 If isBookOpen(fName) Then 204 205' 開いていた場合 206 Ary = Workbooks(fName).Worksheets("計上科目変換表").Cells(1, 1).CurrentRegion 207 Else 208 209' 閉じていた場合の処理 210 Application.DisplayAlerts = False 211 Workbooks.Open fileName:=path & fName, Password:=629545 212 Ary = ActiveWorkbook.Worksheets("計上科目変換表").Cells(1, 1).CurrentRegion 213 ActiveWorkbook.Close 214 Application.DisplayAlerts = True 215 End If 216 217 With wsCnvTable 218 .Cells(1, 1).CurrentRegion.ClearContents 219 .Range(.Cells(1, 1), .Cells(UBound(Ary, 1), UBound(Ary, 2))) = Ary 220 .Cells(1, 12) = getLastUpDate 221 End With 222 223 setCnvTable = Ary 224 Else 225' 更新がされていなかった場合は、同ブック内のシートより参照 226 setCnvTable = wsCnvTable.Cells(1, 1).CurrentRegion 227 End If 228 229 Set wsCnvTable = Nothing '解放 230End Function 231 232Private Function isBookOpen(bookName As String) As Boolean 233 Dim bk As Workbook 234 235 isBookOpen = False '初期設定 236 237' 開いているワークブックを回して該当ファイルが開いているか確認 238 For Each bk In Workbooks 239 If bk.Name = bookName Then 240 isBookOpen = True 241 Exit For 242 End If 243 Next 244 245End Function 246Private Function getDateLastModified(rcLastUpDate As Date) 247' 外部参照データファイルの最新更新日時を取得するコード 248 249 Dim FSO As Object 250 Set FSO = CreateObject("Scripting.FIleSystemObject") 251 252 Dim fName As String 253 Dim path As String 254 Dim d As Date 255 path = ThisWorkbook.path & "\" 256 fName = "外部参照データ.xlsx" 257 On Error Resume Next 258 d = FSO.GetFile(path & fName).DateLastModified 259 If Err.Number <> 0 Then 260 Err.Clear 261 d = rcLastUpDate 262 MsgBox fName & "が見つかりませんでした", vbInformation, "Not find file" 263 End If 264 getDateLastModified = d 265 Set FSO = Nothing 266End Function 267
読み取れなかった内容を修復または削除することにより、ファイルを開くことができました。
削除された機能: /xl/worksheets/sheet1.xml パーツ内のデータの入力規則
と表記され、内容のとおり設定していた入力規則が削除されます。
VBA自体は動くのですが、入力規則で数値のみや日付形式のみといった設定をしていた部分の入力規則が消えてしまう状態です。
入力規則のリストには、どう設定しているのでしょうか？
入力規則はVBAで設定している部分と、エクセルの標準機能で設定している部分があります。 金額や日付など手入力する部分で入力制限を設ける部分は標準機能でリストではなく「整数」「日付」などに設定している状態です
外部参照に関する箇所を重点的に聞きたく、会社名、取引内容は、どうやって入力規則の設定をしているのでしょうか？
外部参照は「前提・実現したいこと」の部分にあるようなつくりとなっています。 まず、請求先会社名に関しては入力シートのWorksheet_Changeイベントで営業所名のセルの位置をトリガーに設定し、Workbooks.Openで外部参照を開き、シートを2次配列にCurrentregionで格納しています。後はForで一行ずつまわしながら配列内の計上営業所が入力シートの営業所名と一致したばあいに別の一次配列へ入れ、String型の変数に「,」区切りに置き換えてからValidationで設定しています。取引内容はトリガーを請求先会社名に置き換えて流れは同様です。
その辺りのコードを提示してもらえませんか？
＜/＞ボタンを使ってください。
回答2件
0
ベストアンサー
コードを拝見しましたが、原因は不明です。
ただ折角ですので、コードレビューを記載しておきますので、ご参考まで。
・Offset,Resizeを多用してますが、
Enumで行・列を定義して利用した方が可読性を上げることが出来ます。
・WorkSheet、Cells、Rangeには、必ず頭に「.」を付ける（＝親からきちんと書く）
ようにした方が、不要なバグに悩まされなくなります。
※暗黙的にActiveな親が参照されるので、デバッグ時や処理が複雑化した時に、
意図しない処理をしてしまう可能性が常にあります。
・「Dim i1, i2, iX As Long」のように複数の変数を宣言していますが、
この場合の「i1」は「Variant型」になっています。
※変数の上で、Ctrl+I で確認してください
・「配列validationを「,」区切りの文字列へ変換」の処理ですが、
「Join(validation,",")」とした方が簡潔です。
・「Workbooks.Open」の後、ActiveWorkBookを使ってますが、
戻り値を WorkBook 型変数に格納して使用した方が確実です。
※Active系は極力使用しない方が、不要なデバッグを回避できます。
・FSOはの生成で「Scripting.FIleSystemObject」となっていますが、
細かい所ですが、FIle → File と小文字です。
また、参照設定で Microsoft Scripting Runtime を参照した方が、
扱いやすくなります。(Set FSO = New Scripting.FileSystemObject)
※別環境で参照できないケースは今のところ未経験です。
以上。
投稿2017/11/14 05:01
総合スコア1175
ExcelVBAerさん長時間にわたり対応してきただきありがとうございました！
また、質問していた内容への対応ばかりではなく
コードに対してもご指摘していただきありがとうございます！！
独学でやっており会社でも私しか触らないのでこういうご指摘はとてもありがたいです。
勉強不足なので初見の内容もありますので調べて改善に努めてまいります。
独学＋独りは大変ですね。
自分も最初は同じような環境だったので。。。
回し者ではありませんが、
「ExcelVBAを実務で使い倒す技術」という本がオススメです。
https://tonari-it.com「いつも隣にITのお仕事」の高橋さんがだされた本ですよね！
VBAの検索をしているといつも見かけるので目に入ってきになっていましたので
ExcelVBAerさんがお勧めしてくださるならさっそく購入してみたいと思います（笑）
そうです！
読んだ後に、あの時にこの本が出ていればな～って思ってしまいました(笑)
全てのVBA関連の本を読んでる訳でないですが、
この本がVBAシステム開発の第一歩として最適かと～
0
単純にエクセルファイルが壊れと思います。
バックアップから修復した方が良いのでは・・・
投稿2017/11/15 11:43
総合スコア344
特定の営業所に切り替えた場合にこの症状が起こります。
もちろんエクセルファイルが壊れたのだろうとは思いますが
どの過程で壊れたのか？壊れるのか？なぜ壊れるのかがわからずというところです。
そうでしたか。
自分もこのメッセージが表示された経験がありますが、
傾向として、「名前の定義」が使用されていると、多いような気がします。
次は、シェイプですかね？
次は、セル自体。
VBAが悪くって壊れたような記憶は、自分の経験上無いような気がします。
でも、ネットワーク上のファイルを扱うと、壊れやすいですよね。
あなたの回答
tips
プレビュー
