比较复杂的检索后复制粘贴

sampsonpon

1、打开同一路径下的"PICKING LIST"文件夹；
2、找到"List-当月当日"文件夹后，按文件修改时间的升序打开一个文件名末尾不为"Read"且文件名不含"CY"或不含"HQ"或不含"RFI"的工作簿(被占用时跳到找下一个，没找到时退出整个sub)，将打开后的工作簿的当前工作表的A2:W值复制粘贴到此处的A:W(总是往下递增粘贴)；
3、将上述打开的工作簿另存为它本身工作簿名称+"Read"，保存到它完全相同路径下并关闭；
4、循环上述123动作。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()    '//2024.7.24
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set reg = CreateObject("VBScript.Regexp")
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     Set sh = ThisWorkbook.Sheets("Org2")
   
8.     p = ThisWorkbook.path & ""
   
9.     With reg
   
10.         .Global = False
    
11.         .Pattern = "Read|CY|HQ|RFI"
    
12.     End With
    
13.     For Each f In fso.GetFolder(p).Files
    
14.         If LCase$(f.Name) Like "*.xls*" Then
    
15.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
16.                 fn = fso.GetBaseName(f)
    
17.                 If Not d.exists(fn) Then
    
18.                     If Not reg.TEST(fn) Then
    
19.                         d(fn) = ""
    
20.                         Set wb = Workbooks.Open(f, 0)
    
21.                         With wb.Sheets(1)
    
22.                             r1 = .Cells(Rows.Count, 1).End(3).Row
    
23.                             arr = .[a2].Resize(r1 - 1, 23)
    
24.                         End With
    
25.                         wb.SaveAs p & fn & "-Read"
    
26.                         wb.Close
    
27.                         r = sh.Cells(Rows.Count, 1).End(3).Offset(1).Row
    
28.                         sh.Cells(r, 1).Resize(UBound(arr), 23) = arr
    
29.                         fso.deletefile f
    
30.                     End If
    
31.                 End If
    
32.             End If
    
33.         End If
    
34.     Next f
    
35.     Set d = Nothing
    
36.     Application.ScreenUpdating = True
    
37.     MsgBox "OK！"
    
38. End Sub
    

复制代码

sampsonpon

ykcbf1100 发表于 2024-7-24 16:18
参与一下。。。

运行完全没问题，结果应该也没问题。但是您没有考虑到我这个AAA工作簿是在下图这个位置，划红线的说明您没考虑

ykcbf1100

sampsonpon 发表于 2024-7-24 16:38
运行完全没问题，结果应该也没问题。但是您没有考虑到我这个AAA工作簿是在下图这个位置，划红线的说 ...

拜托，你那个附件中就没有那个子目录，你自己仔细看一下。
所以，做附件要认真一点的。

sampsonpon

ykcbf1100 发表于 2024-7-24 16:46
拜托，你那个附件中就没有那个子目录，你自己仔细看一下。
所以，做附件要认真一点的。

好吧，我的问题。以后做附件知道了。谢谢！

ykcbf1100

sampsonpon 发表于 2024-7-24 17:23
好吧，我的问题。以后做附件知道了。谢谢！

路径代码改一下就行了，简单。

sampsonpon

ykcbf1100 发表于 2024-7-24 17:32
路径代码改一下就行了，简单。

嗯嗯，这里改了一下可以了

sampsonpon

ykcbf1100 发表于 2024-7-24 16:18
参与一下。。。

老师，有没有必要加一句：And InStr(f.Name, "~$") = 0，当碰到临时文件时

ykcbf1100

sampsonpon 发表于 2024-7-24 17:49
老师，有没有必要加一句：And InStr(f.Name, "~$") = 0，当碰到临时文件时

可以加。。