Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Home : 指定なし)
ファイルからファイルへの転記
投稿日時: 21/09/29 01:21:11
投稿者: TATSUYA.ich

お世話になっております。
 
ファイルの更新を自動化するためにVBAでコードを書いていますが、いつも同じところでデバックが発生します。
何度か試していますが、決まって出てくるデバックの番号は9か13です。
 
ファイルA(NewFile)
ファイルB(OldFile)
 
ファイルC(VBAのファイル)
 
ファイルCで指定した値をファイルB(OldFile)の値に加算してファイルAに転記したいと考えています。
 
workbooks("New_File").worksheets("Sample").cells(r,c).value = workbooks("old_File").worksheets("sample").cells(r,c).value + thisworkbooks.worksheets("変動率入力").cells(4,3).value
 
ThisworkbookというのはファイルCのことです。
 
更新用のファイル(ファイルC)にVBAが記載されており、そのファイルCからマクロで
ファイルA・Bを開き、BのデータにCに打ち込んだ値を加算してファイルAのとあるセルに
値を入力する。
 
こんな簡単なことで質問してしまうのも恐縮ですが、いろいろ試した上で問題が解消できません。
 
何卒問題点等ご指摘くださいます様、よろしくお願い致します。

回答
投稿日時: 21/09/29 09:11:54
投稿者: simple

コードは手打ちではなく、VBEのコードペインから、
コピーペイストされることを推奨します。
また、できれば部分ではなく、ひとつの固まりで提示されたほうがよいのではないですか?
 
Workbooks("New_File")
と書くと、拡張子がないのでエラーになりませんか?
まだ保存していない、そういう名前をつけたブックです、
ということなら結構ですが。
 
いや、それは説明用に標語的に書いたものです、ということことなら、
手間を惜しまず、実際に動作させているものを提示してください。
区別がつきませんから。
 
デバグの応援を頼むのであれば特に、ありのままを示してもらわないといけません。
(むろん固有名詞的なものは変更していただいて一向に構いません)

回答
投稿日時: 21/09/29 09:18:30
投稿者: Suzu

提示されたコードは
 thisworkbooks.Worksheets("変動率入力").Cells(4, 3).Value
  ↓
 thisworkbook.Worksheets("変動率入力").Cells(4, 3).Value
 
 として
 

引用:
決まって出てくるデバックの番号は9か13です。

デバック番号ではなく、エラーコード(番号)ですよね。
 
https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/trappable-errors
を見ると
 
9    インデックスが有効範囲にありません
13    型が一致しません
 
となっています。
 
前者に関しては
 各コレクションのアイテムを指定するのにインデックスを指定していますが、
 そのインデックスが存在しない場合にでてきます。
 その箇所としては
  Workbooks("New_File").Worksheets("Sample").Cells(r, c)
  Workbooks("old_File").Worksheets("sample").Cells(r, c)
  thisworkbook.Worksheets("変動率入力")
 
 ・開いているワークブックに、【New_File】【old_File】 という名称のワークブックが存在しない
    (開いていない)
    (開いていても、一般的には、New_File.xlsx 等の拡張子が必要)
 ・そのワークブックに、【Sample】のシート、ThisWorkBookに 【変動率入力】のシートが無い
 ・ r,c の値が【0】等、セル番地に無い値
 が考えられます。
 
 
後者に関しては
引用:
 Workbooks("old_File").Worksheets("sample").Cells(r, c).Value + thisworkbook.Worksheets("変動率入力").Cells(4, 3).Value

 今回の場合、加算 を行っていますが、セルの値が 片方あるいは両方 文字列 となっている事が考えられます。
 
 
どちらにしても、
普通であるなら、エラーが発生した段階で デバック状態になります
 (黄色でエラーの発生した行で止まります)
その状態で、Cells(r, c).Value の Value の位置にマウスカーソルを持っていくと
参照が出来ているなら、その_Valueの値が表示されます。
 
その値を確認し、 文字列になっていないかを確認すれば、
 エラー13 の発生する原因となるセルの値のシートを特定できるはずです。
 
エラー9 の場合
今回
引用:
Workbooks("New_File").Worksheets("Sample").Cells(r, c).Value
の様にコレクションを多段にしていると、 デバック状態でカーソルを Valueに持って行っても
値が出ないです。
この場合、どの位置のインデックスが悪いのか判断できません。
 
ですから、エラー特定ができない時には、面倒でも
Dim wbk_New As Workbook, wbk_Old As Workbook, wbk_This As Workbook
Dim wst_New As Worksheet, wst_Old As Worksheet, wst_This As Worksheet
Dim rng_New As Range, rng_Old As Range, rng_This As Range

Set wbk_New = Workbooks("New_File")
Set wst_New = wbk_New.Worksheets("Sample")
Set rng_New = wst_New.Cells(r, c)

Set wbk_Old = Workbooks("old_File")
Set wst_Old = wbk_Old.Worksheets("sample")
Set rng_Old = wst_Old.Cells(r, c)


Set wbk_This = ThisWorkbook
Set wst_This = wbk_This.Worksheets("変動率入力")
Set rng_This = wst_This.Cells(4, 3)

の様にコードを変更し、どこで発生しているのか確認する様にしましょう。

投稿日時: 21/09/30 17:45:35
投稿者: TATSUYA.ich

simple さんの引用:
コードは手打ちではなく、VBEのコードペインから、
コピーペイストされることを推奨します。
また、できれば部分ではなく、ひとつの固まりで提示されたほうがよいのではないですか?
 
Workbooks("New_File")
と書くと、拡張子がないのでエラーになりませんか?
まだ保存していない、そういう名前をつけたブックです、
ということなら結構ですが。
 
いや、それは説明用に標語的に書いたものです、ということことなら、
手間を惜しまず、実際に動作させているものを提示してください。
区別がつきませんから。
 
デバグの応援を頼むのであれば特に、ありのままを示してもらわないといけません。
(むろん固有名詞的なものは変更していただいて一向に構いません)

 
Simple様
 
こんにちは。
ご回答ありがとうございます。
 
お返事が遅くなり申し訳ございませんでした。
 
会社のPCのセキュリティが厳しく、コピーしてこのサイトにペーストできないため、このような対応
になってしまいました。
 
申し訳ございません。
 
Workbooks("New_File")
と書くと、拡張子がないのでエラーになりませんか?
 
このNew_Fileの部分は変数を使っています。ダブルコーテーションを使っていたのが誤りでした。
 
今回は以下のとおり記述したところちゃんと動くようになりました。
 
有難うございました!!
 
Sub Update()
 
Dim Path as string
Dim File as string
 
Dim New_File As Workbook ,Old_File As Workbook,wbk_This As workbook
Dim New_File_Name As string,Old_File_Name as String
 
Dim wst_New As Worksheet,wst_Old As worksheet,wst_This As Worksheet
Dim rng_New As Range, rng_Old As Range,rng,This_Of As Range,rng,This_Re As Range
 
Dim R As Integer
Dim C As Integer
 
Path = ThisWorkbook.Path & "\〇〇(フォルダ名)\"
File = Dir(Path & "*.xlsx")
 
New_File_Name = Thisworkbook.worksheets("変動率入力").cells(3,6).value
Old_File_Name = Thisworkbook.worksheets("変動率入力").cells(2,6).value
 
Do While File <> ""
 
   Workbooks.Open Path & File
    
   Workbooks(File).Activate
 
   File = Dir
 
Loop
 
Set New_File = Workbooks(New_File_Name)
Set wst_New = New_File.Worksheets("Of")
Set rng_New = wst_New.cells(32,10)
 
Set Old_File = Workbooks(Old_File_Name)
Set wst_Old = Old_File.Worksheets("Of")
Set rng_Old = wst_Old.cells(32,10)
 
Set wbk_This = ThisWorkbook
Set wst_This = wbk_This.Worksheets("変動率入力")
Set rng_This_Re = wst_This.cells(3,3)
Set rng_This_Of = wst_This.cells(4,3)
 
Application.ScreenUpdating = False
 
Dim i As Long
    For i = 1 To 30000
        Application.StatusBar = "実行中..." & Left(string(int(i/30000*10),"■") _
    String(10,"□"),10)
  Next i
C = 10
 
 For C = 10 To 16 Step2
  wst_New.cells(32,C).value = wst_old.Cells(32,C).value + rng_This_Of.value
 Next c
 
R = 39
C = 10
 
 For C = 10 To 16 Step2
   For R = 39 To 59
      wst_New.cells(R,C).value = wst_old.Cells(R,C).value + rng_This_Of.value
   Next R
 Next C
 
Set wst_New = New_File.Worksheets("Re")
Set wst_Old = Old_File.Worksheets("Re")
 
R = 10
C = 10
 
 For C = 10 To 17
   Select Case C
   Case 10,12,15,17
   For R = 10 To 15
      wst_New.cells(R,C).value = wst_old.Cells(R,C).value + rng_This_Re.value
   Next R
   End Select
 Next C
 
R = 19
 
  For C = 10 To 17
   Select Case C
   Case 10,12,15,17
   For R = 19 To 24
      wst_New.cells(R,C).value = wst_old.Cells(R,C).value + rng_This_Re.value
   Next R
   End Select
 Next C
Application.ScreenUpdating = True
 
Application.StatusBar = False
MsgBox "処理が終了しました。"
 
End sub

投稿日時: 21/09/30 17:48:30
投稿者: TATSUYA.ich

Suzu さんの引用:
提示されたコードは
 thisworkbooks.Worksheets("変動率入力").Cells(4, 3).Value
  ↓
 thisworkbook.Worksheets("変動率入力").Cells(4, 3).Value
 
 として
 
引用:
決まって出てくるデバックの番号は9か13です。

デバック番号ではなく、エラーコード(番号)ですよね。
 
https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/trappable-errors
を見ると
 
9    インデックスが有効範囲にありません
13    型が一致しません
 
となっています。
 
前者に関しては
 各コレクションのアイテムを指定するのにインデックスを指定していますが、
 そのインデックスが存在しない場合にでてきます。
 その箇所としては
  Workbooks("New_File").Worksheets("Sample").Cells(r, c)
  Workbooks("old_File").Worksheets("sample").Cells(r, c)
  thisworkbook.Worksheets("変動率入力")
 
 ・開いているワークブックに、【New_File】【old_File】 という名称のワークブックが存在しない
    (開いていない)
    (開いていても、一般的には、New_File.xlsx 等の拡張子が必要)
 ・そのワークブックに、【Sample】のシート、ThisWorkBookに 【変動率入力】のシートが無い
 ・ r,c の値が【0】等、セル番地に無い値
 が考えられます。
 
 
後者に関しては
引用:
 Workbooks("old_File").Worksheets("sample").Cells(r, c).Value + thisworkbook.Worksheets("変動率入力").Cells(4, 3).Value

 今回の場合、加算 を行っていますが、セルの値が 片方あるいは両方 文字列 となっている事が考えられます。
 
 
どちらにしても、
普通であるなら、エラーが発生した段階で デバック状態になります
 (黄色でエラーの発生した行で止まります)
その状態で、Cells(r, c).Value の Value の位置にマウスカーソルを持っていくと
参照が出来ているなら、その_Valueの値が表示されます。
 
その値を確認し、 文字列になっていないかを確認すれば、
 エラー13 の発生する原因となるセルの値のシートを特定できるはずです。
 
エラー9 の場合
今回
引用:
Workbooks("New_File").Worksheets("Sample").Cells(r, c).Value
の様にコレクションを多段にしていると、 デバック状態でカーソルを Valueに持って行っても
値が出ないです。
この場合、どの位置のインデックスが悪いのか判断できません。
 
ですから、エラー特定ができない時には、面倒でも
Dim wbk_New As Workbook, wbk_Old As Workbook, wbk_This As Workbook
Dim wst_New As Worksheet, wst_Old As Worksheet, wst_This As Worksheet
Dim rng_New As Range, rng_Old As Range, rng_This As Range

Set wbk_New = Workbooks("New_File")
Set wst_New = wbk_New.Worksheets("Sample")
Set rng_New = wst_New.Cells(r, c)

Set wbk_Old = Workbooks("old_File")
Set wst_Old = wbk_Old.Worksheets("sample")
Set rng_Old = wst_Old.Cells(r, c)


Set wbk_This = ThisWorkbook
Set wst_This = wbk_This.Worksheets("変動率入力")
Set rng_This = wst_This.Cells(4, 3)

の様にコードを変更し、どこで発生しているのか確認する様にしましょう。

 
Suzu様
 
ご返信ありがとうございました!!
 
お返事が遅れてすみません。
詳細にご指摘くださいましてありがとうございます。
 
Suzu様のご指摘を確認してコードを整理し、ステップ実行で確認しながら
作業したところ、ちゃんと動くようになりました!!
 
また不明な点があればご質問させて頂くかと思いますが、今後ともよろしくお願いいたします。

回答
投稿日時: 21/09/30 19:35:23
投稿者: simple

折角投稿してもらったので、
全角括弧や全角空白があったりしたので修正して、インデントを直してみました。
さしあたり、気づいた点は以下です。
(1)
    Do While File <> ""
        Workbooks.Open Path & File
        Workbooks(File).Activate
        File = Dir
    Loop
    で開いたものが、 New_FileやOld_Fileなんでしょうけど、
    コード上ではそのことが担保されていない気がします。
 
    ファイル名がわかっているのであれば、
    Set New_File = Workbooks.Open(Path & New_File_Name)
    と書いたほうが明確ではないですか?
 
(2)繰り返しの前で、R,Cに値を代入していますが、必要がないのでは?
(3)StatusBarに表示することが有効なんですかね。そこで時間は掛かってないので、
   表示のための表示という気がします。必要ないのでは?
 

Sub Update()
    Dim Path As String
    Dim File As String

    Dim New_File As Workbook, Old_File As Workbook, wbk_This As Workbook
    Dim New_File_Name As String, Old_File_Name As String

    Dim wst_New As Worksheet, wst_Old As Worksheet, wst_This As Worksheet
    Dim rng_New As Range, rng_Old As Range, rng_This_Of As Range, rng_This_Re As Range

    Dim R As Integer
    Dim C As Integer

    Path = ThisWorkbook.Path & "\〇〇(フォルダ名)\"
    File = Dir(Path & "*.xlsx")

    New_File_Name = ThisWorkbook.Worksheets("変動率入力").Cells(3, 6).Value
    Old_File_Name = ThisWorkbook.Worksheets("変動率入力").Cells(2, 6).Value

    Do While File <> ""
        Workbooks.Open Path & File
        Workbooks(File).Activate
        File = Dir
    Loop

    Set New_File = Workbooks(New_File_Name)
    Set wst_New = New_File.Worksheets("Of")
    Set rng_New = wst_New.Cells(32, 10)

    Set Old_File = Workbooks(Old_File_Name)
    Set wst_Old = Old_File.Worksheets("Of")
    Set rng_Old = wst_Old.Cells(32, 10)

    Set wbk_This = ThisWorkbook
    Set wst_This = wbk_This.Worksheets("変動率入力")
    Set rng_This_Re = wst_This.Cells(3, 3)
    Set rng_This_Of = wst_This.Cells(4, 3)

    Application.ScreenUpdating = False

    Dim i As Long
    For i = 1 To 30000
        Application.StatusBar = "実行中..." & Left(String(Int(i / 30000 * 10), "■") _
                                & String(10, "□"), 10)
    Next i
    
    C = 10  '◆不要では?
    For C = 10 To 16 Step 2
        wst_New.Cells(32, C).Value = wst_Old.Cells(32, C).Value + rng_This_Of.Value
    Next C

    R = 39 '◆不要では?
    C = 10 '◆不要では?
    For C = 10 To 16 Step 2
        For R = 39 To 59
           wst_New.Cells(R, C).Value = wst_Old.Cells(R, C).Value + rng_This_Of.Value
        Next R
    Next C

    Set wst_New = New_File.Worksheets("Re")
    Set wst_Old = Old_File.Worksheets("Re")

    R = 10 '◆不要では?
    C = 10 '◆不要では?
    For C = 10 To 17
        Select Case C
            Case 10, 12, 15, 17
                For R = 10 To 15
                   wst_New.Cells(R, C).Value = wst_Old.Cells(R, C).Value + rng_This_Re.Value
                Next R
        End Select
    Next C

    R = 19 '◆不要では?

    For C = 10 To 17
        Select Case C
            Case 10, 12, 15, 17
                For R = 19 To 24
                   wst_New.Cells(R, C).Value = wst_Old.Cells(R, C).Value + rng_This_Re.Value
                Next R
        End Select
    Next C
    Application.ScreenUpdating = True

    Application.StatusBar = False
    MsgBox "処理が終了しました。"
End Sub

トピックに返信