特定の条件のときは、データを転記しないマクロを作成したいが、条件が効かない

Question

前提・実現したいこと

ExcelファイルからExcelファイル（一覧）へデータを転記するプログラムを作成しました。
（複数の転記元ファイルのデータを、一覧ファイルへ1レコードとして転記）
特定の条件に合致するExcelファイルからはデータを転記しないようにしたいのですが、
実行しても、全てのExcelファイルからデータを転記してしまいます。

作成したソースコードを記載致しますので、知恵をお貸しください。
宜しくお願い致します。

【条件】
一覧ファイルのAQ列がNullの場合は、その該当の転記元ファイルは転記しないようにしたいです。

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

**転記元ファイルのファイル名は「◯◯◯_aaa.xlsx」となっており（◯は固定値）
aaaの部分を一覧のD列に転記しているため、これをキーにソースコードを作成したのですが、うまくいきません。**

該当のソースコード

Option Explicit

Dim mFSO As FileSystemObject

Sub 一覧表更新()
    Dim rngList As Range
    Dim vrtSubjectList As Variant

    Set mFSO = New FileSystemObject

    '一覧表のセル範囲取得
    Set rngList = ThisWorkbook.Worksheets("一覧").Range("A12").CurrentRegion

    '空欄クリア
    InitializeTable rngList

    '一覧にないファイルのリストを取得
    vrtSubjectList = Get_UpdatedSubjectList(rngList)

    'データの転記
    SetUpdated vrtSubjectList, rngList

End Sub

'一覧表中のAQ列が空欄の行をクリア
Private Sub InitializeTable(ByRef rngList As Range)
    Dim rngBlank As Range

    With rngList
        If rngList.Rows.Count > 1 Then
            On Error Resume Next
            Set rngBlank = rngList.Columns(43).SpecialCells(xlCellTypeBlanks)
            On Error GoTo 0
            If rngBlank Is Nothing Then Exit Sub

            rngBlank.EntireRow.ClearContents
            rngList.Sort Key1:=rngList(4), Order1:=xlAscending, Header:=xlYes
        End If
        Set rngList = rngList.CurrentRegion
    End With
End Sub

'一覧表にないファイルのフルパスのリストを取得
Private Function Get_UpdatedSubjectList(ByRef rngList As Range) As Variant
    Dim WSF As WorksheetFunction
    Dim myFolder As folder
    Dim myFile As file
    Dim strPath As String
    Dim strBaseName, BaseName As String
    Dim vrtOld As Variant
    Dim vrtNewList() As Variant
    Dim ix As Long
    
    Dim intPos As Long

    ReDim vrtNewList(1 To 50000)
    Set WSF = Application.WorksheetFunction
    '入力済み管理NOリスト
    vrtOld = WSF.Transpose(rngList.Columns(4))

    strPath = ThisWorkbook.Path

    For Each myFolder In mFSO.GetFolder(strPath).SubFolders
        For Each myFile In myFolder.Files
            BaseName = mFSO.GetBaseName(myFile.Path)
            intPos = InStr(BaseName, "_")
            strBaseName = Mid(BaseName, intPos + 1)
            If IsError(Application.Match(strBaseName, vrtOld, 0)) Then
                ix = ix + 1
                vrtNewList(ix) = myFile.Path
            End If
        Next
    Next

    ReDim Preserve vrtNewList(1 To ix)
    Get_UpdatedSubjectList = vrtNewList
End Function

'データの転記
Private Sub SetUpdated(ByVal vrtSubjectList As Variant, ByRef rngList As Range)
    Dim c As Range
    Dim f As Variant
    Dim strContent(1 To 66) As String
    Dim ix As Long
    Dim vrtNewList() As Variant
    ReDim vrtNewList(LBound(vrtSubjectList) To UBound(vrtSubjectList), 1 To 66)

    For Each f In vrtSubjectList
        ix = ix + 1
        With Workbooks.Open(f, UpdateLinks:=False, ReadOnly:=True) 
            vrtNewList(ix, 1) = .Worksheets("単票").Cells(10, 33).Value

	　　__（※こちらは文字数の制限により、省略致します※）__

            vrtNewList(ix, 66) = .Worksheets("単票").Cells(2, 46).Value

            .Close False
        End With
    Next

    With rngList
        Set rngList = .Cells(.Rows.Count, 2).Resize(UBound(vrtNewList, 1), UBound(vrtNewList, 2))
    End With
    rngList.Value = vrtNewList

End Sub

Comments

[meg_]

「特定の条件に合致するExcelファイルからはデータを転記しない」の処理は上記コードのどのあたりで実装していますか？

[2134]

すみません。記載すべきソースコードが漏れておりました。
ご指摘いただきありがとうございます。

1つ目のプロシージャで、AQ列がNullの行をクリア
2つ目のプロシージャで、一覧にないファイルを転記する

上記によって、AQ列がNullではない場合は、データを転記しないことを実現しようとしています。

[meg_]

関数InitializeTableでデバッグはされましたか？コードを見たところ問題はなさそうですが。

[2134]

ご回答いただきありがとうございます。
ソースコードの全文を記載致しました。
不十分な情報の中、ご回答をさせてしまいすみません。ありがとうございました。

デバックした結果、
> If IsError(Application.Match(strBaseName, vrtOld, 0)) Then
ここでvrtOldに想定したデータが入っておらず、Emptyとなっているため、すべてのファイルのデータを転記してしまっているところまではわかりましたが、vrtOldに想定するデータを入れることができず、苦戦をしている状況です。。。

Answer 1

vrtOld = WSF.Transpose(rngList.Columns(4))

の文ですが、なぜTransposeしているのでしょうか？
回答になっているかわかりませんが、Transposeなしで代入してみてはいかがでしょうか。

Answer 2

If IsError(Application.Match(strBaseName, vrtOld, 0)) Then

↑ここでリストにあるかないかの存在確認をしているので、
そこの行にブレークポイントを置いて、実行をストップし、
変数の中身をローカルウィンドウ等で確認して、
正しく判定できているかどうか確認してみては？

strBaseName　は、ファイルのベースネームを取得しているようですが、
vrtOldにはどんな値が入っているか回答側では確認できません。
拡張子が付いていたり、ファイルのフルパスであったりしたら、
当然存在しないと判定されます。

他人にデバッグを手伝ってもらうなら、時間がどれだけかかろうとも、
回答側でも動作確認ができるよう、シート上のイメージを提示したり、
コードを全文載せるべきでしょう。
そこを横着したら、欲しい情報が貰えないです。
とりあえず、
デバッグの仕方を勉強するなり質問したりした方が、
今後に有益かと思います。
あと、どの行が問題なのかさっぱり当たりが付かないようですが、
1行1行の意味を理解されているのでしょうか？
まずはステップ実行をしながら、一行一行理解されて、
変数の値がその時々で期待通りの値になっているのかを、
ローカルウィンドウで確認するところから始めてみてください。

↓参考サイト＞＞
プロパティ、メソッドの探り方 マクロ記録とＦ１のHelpを使う

Comments

[2134]

ソースコードを割愛し情報が不十分ということ、またあまりに自分で考えることをせず、ご質問してしまったこと、すみません。今後この質問に限らず、質問をする際に気をつけたいと思います。ご指摘をいただきありがとうございました。
いただいた情報から、試行錯誤を繰り返したのですが、時間をかけても修正できず、ご返信が遅くなったことも併せてすみません。
尚、記載のプログラムを修正致しました。転記処理は文字数の制限により、全部は記載できませんでしたが、他はすべて記載しております。

-----
デバックした結果、
> If IsError(Application.Match(strBaseName, vrtOld, 0)) Then
ここで、キーとしている、strBaseNameは意図した通り、ファイル名の一部（「◯◯◯_aaa.xlsx」のaaaの部分）を取得できておりましたが、
vrtOldに想定したデータが入っておらず、Emptyとなっているため、すべてのファイルのデータを転記してしまっているところまではわかりました。
しかし、vrtOldに、一覧のうちAQ列がNullではないのレコードのD列データを入れることができておりません。（コードの意味は理解しているつもりです）
可能であれば、アドバイスをいただけませんでしょうか？

不躾なご質問を繰り返し、恐縮ですが宜しくお願い致します。

[mattuwan]

>しかし、vrtOldに、一覧のうちAQ列がNullではないのレコードのD列データを入れることができておりません。（コードの意味は理解しているつもりです）
>可能であれば、アドバイスをいただけませんでしょうか？

空白セルの値はNullではありません。Emptyです。
Emptyならば、

'入力済み管理NOリスト
vrtOld = WSF.Transpose(rngList.Columns(4))

↑で、止めて、
イミディエイトウィンドウで
？rngList.Columns(4).address(,,,true) [Enter]
（※[Enter]はエンターキー押下の意）
としてみたり、
ウオォッチウィンドウでウォッチ式を上記のようにいれて、
セルの範囲が意図したように正しく指定出来ているか、
確認してみてください。

時間がないので、詳しく見てませんが、
IsError(Application.Match(strBaseName, vrtOld, 0))
の第2引数は、現状、配列を指定してますが、
セル範囲でもいいので、他との関連でどっちがいいか判断できませんが、
セル範囲に変えてもいいかもしれません。

[2134]

ご回答いただきありがとうございました。
ご回答いただいた内容を元に、試行錯誤を繰り返した結果、
> '一覧表のセル範囲取得
> Set rngList = ThisWorkbook.Worksheets("一覧").Range("A12").CurrentRegion
にて正しくセル範囲を指定できていなかったようで（一覧に空白セルが混ざっているため？）
セル範囲の指定を以下に変更することで、解消致しました。
> Set rngList = ThisWorkbook.Worksheets("一覧").Range(Cells(11, 1), Cells(Cells(Rows.Count, 4).End(xlUp).row, Cells(11, Columns.Count).End(xlToLeft).Column))

ありがとうございました。