Q&A
提示されているソースが不完全なためこちらとしては回答がし辛いです。
今のところ動作上気になる点は二点あります。
shori関数がない。
Sheet_path配列に何の値も入れていないためWorkbooks.Openのところで指定パスがEmptyになり実行エラーになる。
Aのファイル(ThisWorkbook)のデータと複数のファイルのデータを全て照合するコードを書きたいと思っています。
配列Sheet(1~179)に複数のファイルのパスが入っています。
AファイルにはG列にデータが入っています
######Aファイル
行番号|F |G |H|
|:--|:--:|--:|
1||初期||
2||テスト||
3||アクション||
4||イベント||
5||デバッグ||
配列に入っている複数のファイルのデータはCC列に入っているが、データ数がバラバラ
Bファイル CC1CC6CC8 など
Cファイル CC1
######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
回答4件
0
うーん、
単に「初期」とそれ以外で結果の表記が違うだけ。
という話のように思いますが…
B処理はできているということですので、上記前提で
(1)「初期」とそれ以外をA処理、B処理で分ける必要なし。
とりあえず全部B処理で処理。結果も一致なければ全部
「不一致」で書き込む
(2)上の処理が終わったあとAファイルをナメて、
Gが「初期」かつHが「不一致」の行があったら
Hを「一致なし」に書き換えればおk。 では?
※意図を外していたらすいません。
投稿2020/08/19 05:40
総合スコア505
0
ベストアンサー
Option Explicit
ExcelVBA
1Sub test() 2 Dim FileList As Variant 3 Dim myFile As Variant 4 Dim rngData As Range 5 Dim rngResults As Range 6 Dim wb As Workbook 7 Dim c As Range 8 Dim flg As Boolean 9 10 '指定のフォルダの配下の全エクセルファイルのフルパスのリストを取得 11 If GetFileList("C:\Users\katou-ken\Documents\Document\25_設計書", FileList) = False Then Exit Sub 12 13 '自ブックの左から1つ目のシートのG列のデータ範囲の取得 14 With ThisWorkbook.Worksheets(1).Columns("G") 15 Set rngData = Application.Range(.Cells(1), .Cells(.Cells.Count).End(xlUp)) 16 End With 17 '取得したセル範囲の右隣りに「不一致」と入力 18 Set rngResults = rngData.Offset(, 1) 19 rngResults.Value = "不一致" 20 21 '取得したリストのファイルを順に開く 22 For Each myFile In FileList 23 Set wb = Workbooks.Open(myFile) 24 '自ブックのG列のデータ範囲のセルを順にみる 25 For Each c In rngData 26 'もし見ているセルの右隣りが「不一致」なら 27 If c.Offset(, 1).Value = "不一致" Then 28 'もし開いたブックの「インデックス」シートに見ている値が存在すれば、その時は、 29 If WorksheetFunction.CountIf(wb.Worksheets("インデックス").Range("CC:CC"), c.Value) > 0 Then 30 '見ているセルの右隣りに「一致」と記入 31 c.Offset(, 1).Value = "一致" 32 End If 33 '不一致があれば目印をつける 34 flg = True 35 End If 36 '次のセルを見る 37 Next 38 39 'ファイルを閉じる 40 wb.Close False 41 'もし、目印がついてなければループを抜ける 42 If flg = False Then Exit For 43 '目印の初期化 44 flg = False 45 '次のファイルへ 46 Next 47End Sub
なさりたいことはこういう流れでは？
行き当たりばったりでコードを書かないで、
フローチャートなり、箇条書きなり書き出してみて、
概略目途が立ってからコードに向かってみては？
ちなみに「一致なし」と「不一致」の違いはなんでしょ？
※「GetFileList」はこちらが勝手につけた自作関数の名前ですので、
このまま実行してもコンパイルエラーになります。
（Option Explicitを明記した場合）
別途自作するなり、今のコードを流用するなりして、ファイルのパスを
配列変数にリストアップしてください。
※提示したコードは、処理の流れを整理するサンプルです。
参考になれば。
投稿2020/08/12 08:56
総合スコア2163
0
処理Aを実行したら処理Bの実行の必要はなく(初期であるなら初期以外であるはずがないので)
検索しているファイル内に初期が一つでも見つかった時点で一致としていいなら、
一致した時点でExit Doで処理を打ち切ればいいと思います。
他の処理で何をやっているかいまいち把握できていないのですが、
それだと問題があるのでしょうか。
VBA
1・・・ 2 '現在考え中の処理2と処理1 3 If target Like "初期" Then 4 5 Call IsContained(target, filename) 6 7 If kekka = True Then 8 this.Cells(e, 8).Value = "一致" 9 Exit Do 10 Else 11 this.Cells(e, 8).Value = "一致なし" 12 End If 13 Else 14 End If 15・・・
投稿2020/08/12 06:26
総合スコア2183
回答ありがとうございます。
データが初期以外であっても、そのデータが比較ファイルの中にあるかチェックさせる必要があります。
データが無い場合は配列Sheet(c)を更新して、また別のファイルと比較します。
これを繰り返し、全てのファイルと比較しても、データが無い場合は不一致を出力します。
もし、データが初期であった場合で、全てのファイルと比較してもデータが無い場合は「一致なし」と出力させます。
しかし、その後2つ目のif文のelseが実行されるのか「不一致」となってしまいます。
一致の後にExit doをするのは良いのですが、一致なしのあとにExit doをしてしまった場合は、一つのファイルとしか比較できなくなってしまいます。
すみません、少し整理してみます
0
まずデータが「初期」かどうかで処理AまたはBに分岐させてその中で一致するデータのあるなしを判断したら良いと思います。
投稿2020/08/12 04:30
総合スコア74
あなたの回答
tips
プレビュー
