提取工作簿名称+工作薄内的两个单元格数据

一一如终

HAWB# &No. of Pcs 件數 需要从EXCLE表提取这两个数据，但是由于需要的这两个数据单元格位置不固定标题（HAWB# &No. of Pcs 件數，），求助下大神

需要3个数据
1.工作薄的名称，但不上全部，只需要第二个空格后面的名称AMU开头的

2.HAWB# 右边单元格的数据

3.No. of Pcs 件數 下边单元的数据

shiruiqiang

没权限。遍历工作簿，正则式或split提取表名，用find找关键字，offset（0，1）取值

我用PYTHON

可以按您需求定制

一一如终

shiruiqiang 发表于 2023-6-2 22:00
没权限。遍历工作簿，正则式或split提取表名，用find找关键字，offset（0，1）取值

谢谢指点，我试下，感谢~

liulang0808

Sub 按钮1_Click()
    Set fso = CreateObject("scripting.filesystemobject")
    pth = ThisWorkbook.Path & "\提取工作簿名称+两个数据\"
    r = 1
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Offset(1).ClearContents
    arr = [a1].Resize(fso.getfolder(pth).Files.Count + 1, 3)
    For Each f In fso.getfolder(pth).Files
        If InStr(fso.getextensionname(f), "xls") > 0 Then
            r = r + 1
            arr(r, 1) = fso.getbasename(f)
            With Workbooks.Open(f)
                Set Rng = .Sheets(1).UsedRange.Find("HAWB#", lookat:=xlWhole)
                If Not Rng Is Nothing Then arr(r, 2) = Rng.Offset(0, 1)
                Set Rng = .Sheets(1).UsedRange.Find("No. of Pcs 件數", lookat:=xlWhole)
                If Not Rng Is Nothing Then arr(r, 3) = Rng.Offset(1)
                .Close False
            End With
        End If
    Next
    [a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

liulang0808

模拟结果供参考。。。。。。

ykcbf1100

参与一下。

一一如终

liulang0808 发表于 2023-6-5 13:21
模拟结果供参考。。。。。。

厉害，谢谢大神的帮助，但是还是有出现提取不了No. of Pcs 件數的情况，麻烦帮忙看看是什么情况

一一如终

ykcbf1100 发表于 2023-6-5 14:22
参与一下。

谢谢大神的帮助，太强大了

liulang0808

一一如终 发表于 2023-6-5 14:38
厉害，谢谢大神的帮助，但是还是有出现提取不了No. of Pcs 件數的情况，麻烦帮忙看看是什么情况

提取不了的，先对比下查找数据是否有出入吧