Question

Excel VBA循环判断指定值

同一路径下有若干个相同格式的文件需要进行检查。
现在想做一个检查用的工作簿（存放代码），放到该路径下执行检查命令。
检查内容：检查各个工作簿F列的最后一个非空单元格的值，是否等于指定单元格A2的值。
值相等时，将没问题的工作簿放进同一路径下的【ok】文件夹中；
值不相等时，将工作簿名依次写进检查表的A列。
望高手指点，回答满意再追加50分。

若以下回答无法解决问题，邀请你更新回答

Answer 1

每个工作薄只有1个sheet ,还是所有sheet 都要检查？
可以做，但是你没说清楚

追问

不好意思，没说清楚。
是多个sheet，格式都是相同的。
只要其中一个sheet不满足条件，就将文件名写到检查表中

追答

如下测试成功：

Sub 遍历当前文件夹下工作薄()
t = Timer
Application.ScreenUpdating = False
Dim i, r, wk As Workbook, sh As Worksheet, rr
p = ThisWorkbook.Path & "\"
s = Dir(p & "*.xls*")
Do While s <> ""
If s <> ThisWorkbook.Name Then
Set wk = Workbooks.Open(p & s)
For k = 1 To wk.Sheets.Count
a = ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Row + 1
r = wk.Sheets(k).Range("F65536").End(xlUp).Row
Set sh = wk.Sheets(k)
If sh.[A2] <> sh.Cells(r, "F") Then
ThisWorkbook.Worksheets(1).Cells(a, 1) = wk.Name
End If
Next k
If ThisWorkbook.Worksheets(1).Cells(a, 1) <> wk.Name Then wk.SaveCopyAs p & "ok\" & wk.Name
wk.Close False
End If
s = Dir
Loop
t1 = Timer - t
MsgBox ("所有工作薄收集完成,用时" & t1 & "秒")
Application.ScreenUpdating = True
End Sub

追问

果然高手风范！基本满足需求了。
有一点小问题，想确认一下。
我这边测试结果，放到ok文件夹的文件在原路径还有一份。

这样吧，不需要对文件进行操作，只在检查表列出文件名即可。
代码应该怎么改？

追答

不是已经列出 有问题的文件名了
现在是要列出没问题的文件名?

追问

额。。还是没说明白，不要ok文件夹的一系列操作。
值相等时，关闭即可。
值不相等时，将工作簿名依次写进检查表的A列。
水平有限，自己想改，没成功。

追答

If ThisWorkbook.Worksheets(1).Cells(a, 1) wk.Name Then wk.SaveCopyAs p & "ok\" & wk.Name

这句拿掉就完了