編集履歴

質問編集履歴

コード追加

2020/08/12 05:37

投稿

yakumo02

スコア103

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -154,24 +154,122 @@
 ```
-グローバル変数 仮で200
+グローバル関数
-Dim Sheet(200) As String 'ファイルのパスとシート名(book.xlsxなど)が合わさったものを格納の配列
+Dim Sheet(200) As String
-Dim Sheet_path(200) 'ファイルのパスだけ配列に格納
+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)
@@ -182,7 +280,7 @@
 e = 2
-c = 1
+c = 1
 d = 1
@@ -190,69 +288,91 @@
-this_line = this.Cells(Rows.Count, 7).End(xlUp).Row 'G列のデータの最終行を取得
+this_line = this.Cells(Rows.Count, 7).End(xlUp).Row 'AファイルG列の最終行の行番号
-Do While this_line > a 'AファイルのG列のデータ分だけループ
+Do While this_line > a 'AファイルのG列の末端までループ
-     target = this.Cells(e, 7).Value '(AファイルG列のデータを取得)
+     target = this.Cells(e, 7).Value 'AファイルG列の文字を取得
-    Do While UBound(Sheet) > d '配列の要素数分だけ繰り返し
+    Do While UBound(Sheet) > d '配列の要素数分だけ取得
-          filename = Sheet(c)  '配列に入っているデータ(比較ファイルのパス)を変数に格納
+          filename = Sheet(c)
-        '関数呼び出し
+        '現在考え中の処理2と処理1
-     　 If target Like "初期" And shori(target,filename) = False
+        If target Like "初期" Then
+           Call IsContained(target, filename)
+           If kekka = True Then
+             this.Cells(e, 8).Value = "一致"
+           Else
-           this.Cells(e, 8).Value = "一致なし"
+             this.Cells(e, 8).Value = "一致なし"
+           End If
         Else
-          this.Cells(e, 8).Value = "一致"
-　　　　Endif
+        End If
-        If Not target Like "初期" And IsContained(target, filename) = True Then    '戻り値がTrueだった場合
+        If Not target Like "初期" Then
+           Call shori(target, filename)
+           If neko = True Then
            this.Cells(e, 8).Value = "一致"
+           Else
+           this.Cells(e, 8).Value = "不一致"
-           Exit Do
+           End If
         Else
-            this.Cells(e, 8).Value = "不一致"
         End If
      d = d + 1
      c = c + 1
      Loop
@@ -260,7 +380,7 @@
      c = 2
-     b = b + 1
+     e = e + 1
      a = a + 1
@@ -270,21 +390,23 @@
 End Sub
-'関数
-Function IsContained(target, filename) As Boolean　'関数
+Function IsContained(target, filename) As Boolean
-path = Sheet_path(b) 'パスだけ変数に代入
+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　`比較ファイルのデータの最終行を取得
+this_line = Workbooks(filename).Worksheets("説明").Cells(Rows.Count, 81).End(xlUp).Row
@@ -300,11 +422,7 @@
- Do While this_line / 2 > i 'データ数分だけ繰り返し　セルが結合してあるので2で割る
+ Do While this_line / 2 > i '最終行までループ
@@ -312,33 +430,33 @@
-       If Workbooks(filename).Worksheets("説明").Cells(j, 81).Value Like target Then      'AファイルG列のデータが、比較ファイルにあれば
+       If Workbooks(filename).Worksheets("説明").Cells(j, 81).Value Like target Then      '比較ファイルにAファイルと同じデータが存在するなら
-          IsContained = True
+          kekka = True
           Exit Do
       Else
           i = i + 1
           j = j + 2
        End If
-    IsContained = False
+     kekka = False
  Loop
@@ -352,4 +470,94 @@
 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
 ```

2020/08/12 05:37

投稿

yakumo02

スコア103

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -130,9 +130,9 @@
 2||テスト|一致|
-3||アクション|不一致|
+3||API|不一致|
-4||イベント|不一致|
+4||LINE|不一致|
 5||デバッグ|一致|