如何把工作簿的名称动态写入A列

458863601

怎样把每个工作簿的工作表数据前面添加工作簿名称，如：23秋季中洲镇二年级期末调研成绩表工作簿名称，我只要二年级这几个字符，

liulang0808

建议楼主结合附近内容指定具体文件位置进行描述说明

ykcbf1100

真没看懂。提取二年级应该不难，就是不知道放哪里

魂断蓝桥

Sub a()
    Dim arr, mypath, myfile, i&, j&, s$, d
    mypath = ThisWorkbook.Path & "\"
    Dim tosh As Workbook
    Application.ScreenUpdating = False
    Set d = CreateObject("Scripting.Dictionary")
    myfile = Dir(mypath & "*.xls*")
    Do While myfile <> ""
        If myfile <> ThisWorkbook.Name Then
            s = myfile
            j = InStr(s, "年级")
            s = Mid(s, j - 1, 3)
            Set tosh = Workbooks.Open(ThisWorkbook.Path & "\" & myfile)
            tosh.Sheets(s & "学生名单").Activate
            arr = [A1].CurrentRegion
            tosh.Close 0
            For i = 3 To UBound(arr)
                For j = 3 To UBound(arr, 2)
                    If arr(i, j) <> "" Then
                        s = arr(2, j) & "@" & arr(i, 1) & arr(i, j)
                        d(s) = arr(1, 1)
                    End If
                Next
            Next
        End If
    myfile = Dir
Loop
Sheets("数据").Activate
[A:A] = ""
arr = Range("A1:D" & [B9999].End(3).Row)
For i = 2 To UBound(arr)
    s = arr(i, 2) & "@" & arr(i, 3) & arr(i, 4)
    arr(i, 1) = d(s)
Next
[A1].Resize(UBound(arr), 4) = arr
Set d = Nothing
Application.ScreenUpdating = True
End Sub

458863601

ykcbf1100 发表于 2024-6-14 14:20
真没看懂。提取二年级应该不难，就是不知道放哪里

我弄好了，研究一下午，