VBA 複数条件

Question

Aのファイル(ThisWorkbook)のデータと複数のファイルのデータを全て照合するコードを書きたいと思っています。
配列Sheet(1~179)に複数のファイルのパスが入っています。

AファイルにはG列にデータが入っています
######Aファイル
行番号|F |G |H|
|:--|:--:|--:|
1||初期||
2||テスト||
3||アクション||
4||イベント||
5||デバッグ||

配列に入っている複数のファイルのデータはCC列に入っているが、データ数がバラバラ
Bファイル CC1CC6
Cファイル CC1CC8 など

######Bファイル
行番号|CB |CC | CD |
|:--|:--:|--:|
1||イベント||
2||検索||
3||デバッグ|
4||PHP||
5||AWS|
6||初期||

######Cファイル
行番号|CB |CC | CD |
|:--|:--:|--:|
1||C#||
2||テスト||
3||Ruby|
4||Java||
5||C||
6||エラー||
7||Python||
8||module||

実装したいことは、以下の2つです

##処理A

もしAファイルのG列のデータが「初期」で、配列に入っているどれかのファイルのデータに初期という文字が1つでもあれば、真横のH列に「一致」という文字を入力。無ければ「一致なし」を入力。
(例)AファイルのG1が初期であり、Sheet(1)に入っているBファイルのCC6に初期という文字があれば、AファイルのH2に一致を入力。全ファイルと比較し、無ければ不一致を入力

######Aファイル
行番号|F |G |H|　　　　　　　
|:--|:--:|--:|
1||初期|一致|
2||テスト||
3||アクション||
4||イベント||
5||デバッグ||

##処理B
AファイルのG列のデータが「初期」以外である場合は、配列に入っているどれかのファイルのデータに、Aファイルと同じデータが1つでもあれば、「一致」という文字を入力。無ければ「不一致」を入力。
(例)AファイルのG2がテストであり、Sheet(2)に入っているCファイルのCC2にテストという文字があれば、AファイルのH3に一致を入力。全ファイルと比較し、無ければ不一致を入力

######Aファイル
行番号|F|G|H|
|:--|:--:|--:|
1||初期|一致|
2||テスト|一致|
3||API|不一致|
4||LINE|不一致|
5||デバッグ|一致|

現在は、処理Bは実装できたのですが、処理Aの実装ができません。
初期という文字に一致しなかった場合に[一致なし]と入力させたいので、プロシージャにif文を2つ書き、初期という文字の場合の関数(コードに書いてある関数とほとんど同じなので略)を作ってみたのですが、最後は　Else this.Cells(e, 8).Value = "不一致"に上書きされてしまい、[不一致]となってしまいます。
一致、不一致、一致なしの記述をできるようにしたいと思っています。
ご教授お願いします。

コード

グローバル関数
Dim Sheet(200) As String
Dim Sheet_path(200)
Dim b As Long
Dim c As Long
Dim kekka
Dim neko
Dim a As Long

sub call
Call FileSearch("C:\Users\katou-ken\Documents\Document\25_設計書")

End sub

'SheetとSheet_pathに比較ファイルのデータとパスを入れる
Sub FileSearch(path As String)

Dim FSO As Object, Folder As Variant, File As Variant, buf As String, this As Worksheet

Set FSO = CreateObject("Scripting.FileSystemObject")
Set this = ThisWorkbook.Worksheets("イベント")


buf = Dir(path & "*サンプル.xls*")


Do While buf <> ""

Sheet(b) = buf
Sheet_path(b) = path

b = b + 1
buf = Dir()


If b > 178 Then

Call hikaku

End If

Loop
 

For Each Folder In FSO.GetFolder(path).SubFolders
   Call FileSearch(Folder.path)
Next Folder




End Sub


Sub hikaku()

Set this = ThisWorkbook.Worksheets("イベント")
'MsgBox Sheet_path(4)



a = 1  
e = 2  
c = 1  
d = 1  


this_line = this.Cells(Rows.Count, 7).End(xlUp).Row 'AファイルG列の最終行の行番号


Do While this_line > a 'AファイルのG列の末端までループ

     target = this.Cells(e, 7).Value 'AファイルG列の文字を取得

    Do While UBound(Sheet) > d '配列の要素数分だけ取得

          filename = Sheet(c)  

        
        
        
        '現在考え中の処理2と処理1
        If target Like "初期" Then
        
           Call IsContained(target, filename)
           
           If kekka = True Then
             this.Cells(e, 8).Value = "一致"
           Else
             this.Cells(e, 8).Value = "一致なし"
           End If
        Else
        End If
        
        If Not target Like "初期" Then
           Call shori(target, filename)
           
           If neko = True Then
           this.Cells(e, 8).Value = "一致"
           
           Else
           this.Cells(e, 8).Value = "不一致"
           End If
        Else
        End If
        
    
     d = d + 1
     c = c + 1
     
     Loop
     d = 1
     c = 2
     e = e + 1
     a = a + 1
 Loop

End Sub

Function IsContained(target, filename) As Boolean


path = Sheet_path(c)

Set open_file = Workbooks.Open(filename:=path & "\" & filename, UpdateLinks:=False)

this_line = Workbooks(filename).Worksheets("説明").Cells(Rows.Count, 81).End(xlUp).Row

i = 1
j = 10


Application.ScreenUpdating = False

 Do While this_line / 2 > i '最終行までループ

ThisWorkbook.Activate

       If Workbooks(filename).Worksheets("説明").Cells(j, 81).Value Like target Then      '比較ファイルにAファイルと同じデータが存在するなら
    
           
          kekka = True
          
          Exit Do
          
      Else
      
          i = i + 1
          j = j + 2
          
       End If
     kekka = False
 Loop
Workbooks(filename).Close


Application.ScreenUpdating = True
End Function



Function shori(target, filename) As Boolean


path = Sheet_path(c)

Set open_file = Workbooks.Open(filename:=path & "\" & filename, UpdateLinks:=False)

this_line = Workbooks(filename).Worksheets("説明").Cells(Rows.Count, 81).End(xlUp).Row

i = 1
j = 10


Application.ScreenUpdating = False

 Do While this_line / 2 > i 'filename???I?s-9 =i ??(?w?????t?@?C????S?s?????????????[?v)
 
'Set open_file = Workbooks.Open(filename:=path & "\" & filename, UpdateLinks:=False)

ThisWorkbook.Activate

       If Workbooks(filename).Worksheets("説明").Cells(j, 81).Value Like target Then      '
    
  
          neko = True
          
          Exit Do
          
      Else
      
          i = i + 1
          j = j + 2
          
       End If
     neko = False
 Loop
Workbooks(filename).Close


Application.ScreenUpdating = True
End Function

Comments

[yureighost]

提示されているソースが不完全なためこちらとしては回答がし辛いです。
今のところ動作上気になる点は二点あります。
shori関数がない。
Sheet_path配列に何の値も入れていないためWorkbooks.Openのところで指定パスがEmptyになり実行エラーになる。

[yakumo02]

追加しました。よろしくお願いします

Answer 1

うーん、
単に「初期」とそれ以外で結果の表記が違うだけ。
という話のように思いますが…

B処理はできているということですので、上記前提で

(1)「初期」とそれ以外をA処理、B処理で分ける必要なし。
とりあえず全部B処理で処理。結果も一致なければ全部
「不一致」で書き込む

(2)上の処理が終わったあとAファイルをナメて、
Gが「初期」かつHが「不一致」の行があったら
Hを「一致なし」に書き換えればおk。 では?

※意図を外していたらすいません。

Answer 2

Option Explicit

Sub test()
    Dim FileList As Variant
    Dim myFile As Variant
    Dim rngData As Range
    Dim rngResults As Range
    Dim wb As Workbook
    Dim c As Range
    Dim flg As Boolean
    
    '指定のフォルダの配下の全エクセルファイルのフルパスのリストを取得
    If GetFileList("C:\Users\katou-ken\Documents\Document\25_設計書", FileList) = False Then Exit Sub
    
    '自ブックの左から1つ目のシートのG列のデータ範囲の取得
    With ThisWorkbook.Worksheets(1).Columns("G")
        Set rngData = Application.Range(.Cells(1), .Cells(.Cells.Count).End(xlUp))
    End With
    '取得したセル範囲の右隣りに「不一致」と入力
    Set rngResults = rngData.Offset(, 1)
    rngResults.Value = "不一致"
    
    '取得したリストのファイルを順に開く
    For Each myFile In FileList
        Set wb = Workbooks.Open(myFile)
        '自ブックのG列のデータ範囲のセルを順にみる
        For Each c In rngData
            'もし見ているセルの右隣りが「不一致」なら
            If c.Offset(, 1).Value = "不一致" Then
                'もし開いたブックの「インデックス」シートに見ている値が存在すれば、その時は、
                If WorksheetFunction.CountIf(wb.Worksheets("インデックス").Range("CC:CC"), c.Value) > 0 Then
                    '見ているセルの右隣りに「一致」と記入
                    c.Offset(, 1).Value = "一致"
                End If
                '不一致があれば目印をつける
                flg = True
            End If
        '次のセルを見る
        Next
        
        'ファイルを閉じる
        wb.Close False
        'もし、目印がついてなければループを抜ける
        If flg = False Then Exit For
        '目印の初期化
        flg = False
    '次のファイルへ
    Next
End Sub

なさりたいことはこういう流れでは？
行き当たりばったりでコードを書かないで、
フローチャートなり、箇条書きなり書き出してみて、
概略目途が立ってからコードに向かってみては？

ちなみに「一致なし」と「不一致」の違いはなんでしょ？

※「GetFileList」はこちらが勝手につけた自作関数の名前ですので、
このまま実行してもコンパイルエラーになります。
（Option Explicitを明記した場合）
別途自作するなり、今のコードを流用するなりして、ファイルのパスを
配列変数にリストアップしてください。

※提示したコードは、処理の流れを整理するサンプルです。
参考になれば。

Answer 3

処理Aを実行したら処理Bの実行の必要はなく(初期であるなら初期以外であるはずがないので)
検索しているファイル内に初期が一つでも見つかった時点で一致としていいなら、
一致した時点でExit Doで処理を打ち切ればいいと思います。
他の処理で何をやっているかいまいち把握できていないのですが、
それだと問題があるのでしょうか。

・・・
            '現在考え中の処理2と処理1
            If target Like "初期" Then
    
               Call IsContained(target, filename)
    
               If kekka = True Then
                 this.Cells(e, 8).Value = "一致"
                 Exit Do
               Else
                 this.Cells(e, 8).Value = "一致なし"
               End If
            Else
            End If
・・・

Comments

[yakumo02]

回答ありがとうございます。
データが初期以外であっても、そのデータが比較ファイルの中にあるかチェックさせる必要があります。
データが無い場合は配列Sheet(c)を更新して、また別のファイルと比較します。
これを繰り返し、全てのファイルと比較しても、データが無い場合は不一致を出力します。
もし、データが初期であった場合で、全てのファイルと比較してもデータが無い場合は「一致なし」と出力させます。
しかし、その後2つ目のif文のelseが実行されるのか「不一致」となってしまいます。
一致の後にExit doをするのは良いのですが、一致なしのあとにExit doをしてしまった場合は、一つのファイルとしか比較できなくなってしまいます。

[yakumo02]

すみません、少し整理してみます

Answer 4

まずデータが「初期」かどうかで処理AまたはBに分岐させてその中で一致するデータのあるなしを判断したら良いと思います。