質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.75%

  • VBA

    1641questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1403questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

エクセルBookの一部の内容に問題が見つかりました。

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 1
  • VIEW 1,637

lazyAnt

score 3

前提・実現したいこと

複数営業所がある会社に勤めており、
Excel VBAで郵送されてきた請求書類の情報を
各営業所でエクセルに入力するシートを作成しています。
入力シートは簡易化していますが下記の請求情報を入力します。
・請求会社名(入力規則・リスト)
・取引内容(入力規則・リスト)
・勘定科目(自動設定)
・補助科目(自動設定)
・請求金額(手入力)

郵送されてくる請求書類は毎月同じところからくるため(例外もあるが)
入力規則でリスト選択をで基本する仕様にしています。
ただし、営業所によって届く請求書類は異なるので
入力シート:A1に営業所名のリストを作成し、変更することで
請求会社名と取引内容の入力規則をValidationで変更をかけています。

同フォルダ内に下の2ファイルを入れて、外部参照データは下表の様に作成し
営業所名が変更されると、請求会社名と取引内容の変更をかけ、
取引内容が変更されると、請求会社名と取引内容に応じた勘定科目・補助科目名を
拾ってくるようにしています。

・外部参照データ.xlsx(以降、外部参照データ)
・入力シート.xlsm(以降、入力シート)

請求会社名 取引内容 勘定科目 補助科目名 計上営業所
A列 B列 C列 D列 E列

文才が無いのでわかりずらいですが、これらの仕組み自体は無事でき、
動作もしているのですが、一部の営業所名にしたときだけエラーが発生してしまう状態です。

使用環境
・Windows7
・Excel 2013 64bit

発生している問題・エラーメッセージ

エクセルを開いた直後に

「入力シート.xlsm」の一部の内容に問題が見つかりました。可能な限り内容を修復しますか?ブックの発行元が信頼できる場合は「はい」をクリックしてください。

試したこと

問題が起きる営業所・起きない営業所があることから
入力規則へ入れ込むデータに異常があるのかなと考え
外部参照データで問題が起きる営業所の対象データだけに絞りこみ
例えば10行データあったとすると
1行だけ残し残り9行を削除し実行
問題なければ2行だけ残し、残りを削除し実行...のように
試していきましたがエラーは出たりでなかったりと、原因の追究にいたりませんでした。

私の頭では他に考えが浮かばず、
考え方自体がおかしいのかなと思い、今回質問をさせていただきました。

初歩的なことだったり、文章に不十分な点があったら大変申し訳ないのですが
教えていただけますでしょうか?
よろしくお願いいたします。

追記

Option Explicit


Private Sub Worksheet_Change(ByVal TargetRange As Range)

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim Target As Range

    ml_set.setSheets
    arrLO = setCnvTable
    If TargetRange.Column <= 2 And TargetRange.row > 3 Then

'        セルを範囲指定していた場合のループ処理
        For Each Target In TargetRange

            Select Case Target.Column

                Case 1 '        相手先名が選択されたら
                    Call wsUnProtect
                    Target.Offset(, 1).Resize(, 4).ClearContents    '取引内容~金額(税込)までをクリア
                    Call setCellLocked(Target.Offset(, 4), False)   '金額(税込)のロック解除

                    Select Case Target.Value
                        Case ""   '相手先名が空白だった場合リセット
                            Target.Offset(, 1).Resize(, 12).ClearContents
                            With Target.Offset(, 1).validation
                                .Delete
                                .Add Type:=xlValidateList, _
                                    Operator:=xlEqual, _
                                    Formula1:="相手先名を設定してください"
                                    .InputMessage = "取引内容の先に相手先名を設定してください"
                                    .ShowError = False
                                    .ShowInput = True
                            End With

                        Case Else    '相手先名が空白じゃなければ取引内容をセット
                            Call setTradeValidationRule(Target)
                            If Cells(1, 4) <> "本社" Then Target.Offset(, 7) = Cells(1, 4)

                    End Select
                    Call wsProtect

                Case 2 '        取引内容が選択されたら

                    If Target.Offset(, -1) = "" Then    '相手先名が空だったら取引内容をリセット
                        Target.ClearContents

                    Else
                        Select Case Target.Value
'                           取引内容を空にしたら、勘定科目~支払口座名(計上営業所を除く)までをリセットする
                            Case Is = ""
                                Call setCellLocked(Target.Offset(, 3), False)
                                Target.Offset(, 1).Resize(, 5).ClearContents
                                Target.Offset(, 7).Resize(, 4).ClearContents

'                           取引内容をセットしたら、勘定科目~金額・支払口座名をセットする
                            Case Else
                                Target.Offset(, 1).Resize(, 3).ClearContents
                                Call setSubjects(Target)
                                If Not IsEmpty(Target.Offset(, 3).Value) Or Target.Offset(, 3).Value > 0 Then
                                    Call setCellLocked(Target.Offset(, 3), True)
                                Else
                                    Call setCellLocked(Target.Offset(, 3), False)
                                End If

                        End Select
                    End If
            End Select
        Next

    End If

    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Public Sub setTargetValidationRule()
'    請求先会社名の設定
'
    ReDim validation(0)

    Dim i1, i2, iX As Long
    Dim office, company As String

    office = wsInput.Cells(1, 4)
    company = wsInput.Cells(1, 2)

    For i1 = 2 To UBound(arrLO)
        If company = arrLO(i1, 8) And office = arrLO(i1, 5) And arrLO(i1, 9) <> "共通" Then
            For i2 = 0 To UBound(validation)
                If validation(i2) = arrLO(i1, 1) Then
                    Exit For
                ElseIf i2 = UBound(validation) Then
                    ReDim Preserve validation(iX)
                    validation(iX) = arrLO(i1, 1)
                    iX = iX + 1
                End If
            Next i2
        End If
    Next i1

    If iX > 0 Then
        Call setValidation(wsInput.Range("A4:A300"), validation, False)
    End If
End Sub

Public Sub setTradeValidationRule(Target As Range)
'    取引内容の設定    
    Dim validation()

    Dim i1 As Long
    Dim iX As Long

    Dim office As String
    office = wsInput.Cells(1, 4)

    For i1 = 2 To UBound(arrLO)
        If office = arrLO(i1, 5) And Target = arrLO(i1, 1) And Not IsEmpty(arrLO(i1, 2)) Then
            ReDim Preserve validation(iX)
            validation(iX) = arrLO(i1, 2)
            iX = iX + 1
        End If
    Next i1

    If iX > 0 Then
        Call setValidation(Target.Offset(, 1), validation, False)
    Else
        With Target.Offset(, 1).validation
                    .Delete
                    .Add xlValidateInputOnly
                    .InputMessage = "「" & Target + "」は、取引内容が設定されていません" + vbNewLine + "取引内容は直接入力をしてください"
                    .ShowInput = True
                    .IMEMode = xlIMEModeHiragana
        End With
    End If
End Sub

Public Sub setValidation(Target As Range, validation, isErr As Boolean)
'   入力規則リストの設定function
'   isErr の値で直接入力の可否を分岐する

    Dim i1 As Long
    Dim str, _
        inputMsg, _
        errMsg As String

    Select Case isErr
        Case False
            inputMsg = "プルダウンに選択したい項目がない場合は、直接入力してください"
        Case True
            inputMsg = "プルダウンから選択してください"
            errMsg = "入力できる値はプルダウンの値のみです"
    End Select

    For i1 = 0 To UBound(validation)    '配列validationを「,」区切りの文字列へ変換
        str = str + validation(i1)
        If i1 < UBound(validation) Then str = str + ","
    Next i1

    If str = "" Then str = "取引内容が設定されていません、直接入力をしてください"  'リストの文字列が空だった場合、代替文字を代入

    With Target.validation
        .Delete     'validationを設定する場合ははじめに必ずDelete
        .Add Type:=xlValidateList, _
            AlertStyle:=xlValidAlertStop, _
            Operator:=xlEqual, _
            Formula1:=str
        .InputMessage = inputMsg
        .ErrorMessage = errMsg
        .ShowInput = True
        .ShowError = isErr
        .IMEMode = xlIMEModeHiragana
    End With

End Sub

Public Function setCnvTable()
'   外部参照データにある計上科目変換表をThisWorkbookへ取り込むコード
'   最新更新日時をトリガーとして、Workbook内に控えてある前回の最新更新日時からアップデートがされていたら再取り込みを行う。
'   毎回の外部参照をすると動作遅延が生じるための動作高速化処理

    Dim wsCnvTable As Worksheet
    Dim path As String
    Dim wb As Workbook
    Dim fName As String
    Dim Ary
    Dim rcLastUpDate As Date
    Dim getLastUpDate As Date

    Set wsCnvTable = Worksheets("計上科目変換表")
    rcLastUpDate = wsCnvTable.Cells(1, 12)  '控えてある最新更新日時をセット

    getLastUpDate = getDateLastModified(rcLastUpDate) '現在の外部参照データファイルの最新更新日時を取得

    If getLastUpDate > rcLastUpDate Then    '取得した現在の更新日時
        path = ThisWorkbook.path & "\"
        fName = "外部参照データ.xlsx"

'      同ファイルが開いていた場合はデータだけを取得し開いたままに、閉じていた場合はデータ取得後閉じる処理分岐
        If isBookOpen(fName) Then

'            開いていた場合
            Ary = Workbooks(fName).Worksheets("計上科目変換表").Cells(1, 1).CurrentRegion
        Else

'          閉じていた場合の処理
            Application.DisplayAlerts = False
            Workbooks.Open fileName:=path & fName, Password:=629545
            Ary = ActiveWorkbook.Worksheets("計上科目変換表").Cells(1, 1).CurrentRegion
            ActiveWorkbook.Close
            Application.DisplayAlerts = True
        End If

        With wsCnvTable
            .Cells(1, 1).CurrentRegion.ClearContents
            .Range(.Cells(1, 1), .Cells(UBound(Ary, 1), UBound(Ary, 2))) = Ary
            .Cells(1, 12) = getLastUpDate
        End With

        setCnvTable = Ary
    Else
'      更新がされていなかった場合は、同ブック内のシートより参照
        setCnvTable = wsCnvTable.Cells(1, 1).CurrentRegion
    End If

    Set wsCnvTable = Nothing    '解放
End Function

Private Function isBookOpen(bookName As String) As Boolean
    Dim bk As Workbook

    isBookOpen = False    '初期設定

'  開いているワークブックを回して該当ファイルが開いているか確認
    For Each bk In Workbooks
        If bk.Name = bookName Then
            isBookOpen = True
            Exit For
        End If
    Next

End Function
Private Function getDateLastModified(rcLastUpDate As Date)
'   外部参照データファイルの最新更新日時を取得するコード

    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FIleSystemObject")

    Dim fName As String
    Dim path As String
    Dim d As Date
    path = ThisWorkbook.path & "\"
    fName = "外部参照データ.xlsx"
    On Error Resume Next
    d = FSO.GetFile(path & fName).DateLastModified
    If Err.Number <> 0 Then
        Err.Clear
        d = rcLastUpDate
        MsgBox fName & "が見つかりませんでした", vbInformation, "Not find file"
    End If
    getDateLastModified = d
    Set FSO = Nothing
End Function
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • lazyAnt

    2017/11/14 10:55

    外部参照は「前提・実現したいこと」の部分にあるようなつくりとなっています。 まず、請求先会社名に関しては入力シートのWorksheet_Changeイベントで営業所名のセルの位置をトリガーに設定し、Workbooks.Openで外部参照を開き、シートを2次配列にCurrentregionで格納しています。後はForで一行ずつまわしながら配列内の計上営業所が入力シートの営業所名と一致したばあいに別の一次配列へ入れ、String型の変数に「,」区切りに置き換えてからValidationで設定しています。取引内容はトリガーを請求先会社名に置き換えて流れは同様です。

    キャンセル

  • ExcelVBAer

    2017/11/14 11:17

    その辺りのコードを提示してもらえませんか?

    キャンセル

  • ExcelVBAer

    2017/11/14 11:22

    </>ボタンを使ってください。

    キャンセル

回答 2

checkベストアンサー

+2

コードを拝見しましたが、原因は不明です。

ただ折角ですので、コードレビューを記載しておきますので、ご参考まで。

・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 16:11

    ExcelVBAerさん長時間にわたり対応してきただきありがとうございました!
    また、質問していた内容への対応ばかりではなく
    コードに対してもご指摘していただきありがとうございます!!
    独学でやっており会社でも私しか触らないのでこういうご指摘はとてもありがたいです。

    勉強不足なので初見の内容もありますので調べて改善に努めてまいります。

    キャンセル

  • 2017/11/14 16:27

    独学+独りは大変ですね。
    自分も最初は同じような環境だったので。。。

    回し者ではありませんが、
    「ExcelVBAを実務で使い倒す技術」という本がオススメです。

    キャンセル

  • 2017/11/14 16:42

    https://tonari-it.com「いつも隣にITのお仕事」の高橋さんがだされた本ですよね!
    VBAの検索をしているといつも見かけるので目に入ってきになっていましたので
    ExcelVBAerさんがお勧めしてくださるならさっそく購入してみたいと思います(笑)

    キャンセル

  • 2017/11/14 16:49 編集

    そうです! 
    読んだ後に、あの時にこの本が出ていればな~って思ってしまいました(笑)

    全てのVBA関連の本を読んでる訳でないですが、
    この本がVBAシステム開発の第一歩として最適かと~

    キャンセル

0

単純にエクセルファイルが壊れと思います。
バックアップから修復した方が良いのでは・・・

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/11/16 00:50

    特定の営業所に切り替えた場合にこの症状が起こります。
    もちろんエクセルファイルが壊れたのだろうとは思いますが
    どの過程で壊れたのか?壊れるのか?なぜ壊れるのかがわからずというところです。

    キャンセル

  • 2017/11/20 22:06

    そうでしたか。
    自分もこのメッセージが表示された経験がありますが、
    傾向として、「名前の定義」が使用されていると、多いような気がします。
    次は、シェイプですかね?
    次は、セル自体。
    VBAが悪くって壊れたような記憶は、自分の経験上無いような気がします。
    でも、ネットワーク上のファイルを扱うと、壊れやすいですよね。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.75%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • VBA

    1641questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1403questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。