关于查找指定目录下包含关键字的表达式

accord24l

各Excel大师好


      求助关于一个VBA表达指定目录下包含关键字文件的表达式
我原来用录制宏的方式，在A表（SRP小时报）打开，运行 宏 ，打开B表 把内容复制到A表中，这个在VBA表达中是：


Sub 导入工单表头()
'
Application.ScreenUpdating = False
    Dim wb As Workbook
    Set wb = GetObject("D:\信息日报\工单表头.xlsx") '
    With wb.Sheets(1).Range("A1").CurrentRegion '
        Sheet3.Range("A2").Resize(.Rows.Count, .Columns.Count) = .Value '
    End With
    wb.Close False
    Application.ScreenUpdating = True
'
End Sub


实际使用过程中，B表的文件名字都是以 工单表头+序列号 方式，每次都要重命名 删除序列号，保留文件名“工单表头”，才可以被识别
所以我想能不能把语言改成 文件名中包含关键字“工单表头”，执行方式不变。请大神帮忙写一下语言，谢谢！

ykcbf1100

上个附件啊

accord24l

ykcbf1100 发表于 2024-12-16 16:42
上个附件啊

上传了

ykcbf1100

导入工单表头

ykcbf1100

参与一下。。。

1. Sub 导入工单表头()  '//2024.12.16
   
2.     Application.ScreenUpdating = False
   
3.     Set Sh = ThisWorkbook.Sheets("贴工单表头")
   
4.     With Application.FileDialog(msoFileDialogFilePicker)
   
5.         .InitialFileName = ThisWorkbook.Path & ""
   
6.         .Title = "请选择对应Excel文件"
   
7.         .AllowMultiSelect = False
   
8.         .Filters.Clear
   
9.         .Filters.Add "Excel文件", "*.xls*"
   
10.         If .Show Then f = .SelectedItems(1) Else Exit Sub
    
11.     End With
    
12.     Set wb = Workbooks.Open(f, 0)
    
13.     arr = wb.Sheets(1).UsedRange
    
14.     wb.Close False
    
15.     With Sh
    
16.         .UsedRange.Clear
    
17.         .Columns(1).NumberFormatLocal = "@"
    
18.         .[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
19.     End With
    
20.     Application.ScreenUpdating = True
    
21.     MsgBox "OK！"
    
22. End Sub
    

复制代码

accord24l

ykcbf1100 发表于 2024-12-16 17:54
参与一下。。。

老师，我再上传了 工单明细 附件，我按照您给的代码线下做了 贴工单表头，我需要从B2开始贴数据，这个我修改了，可以达到效果。但是A列我是用来计算的，代码中粘贴过去后，A列的公式被清空，代码中不知道如何修改，请老师帮忙看一下

ykcbf1100

accord24l 发表于 2024-12-17 09:41
老师，我再上传了 工单明细 附件，我按照您给的代码线下做了 贴工单表头，我需要从B2开始贴数据，这个我 ...

这二句改一下：
        .Columns(2).NumberFormatLocal = "@"
        .[b1].Resize(UBound(arr), UBound(arr, 2)) = arr