求助代码修改

458863601

Sub ConsolidateDataFromSelectedFolder正确()
    Dim folderPath As String
    Dim fileName As String
    Dim workBk As Workbook
    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long

    ' 提示用户选择文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
       .Title = "请选择一个文件夹"
       .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "没有选择文件夹，程序将退出。", vbExclamation, "错误"
            Exit Sub
        End If
        folderPath = .SelectedItems(1) & "\"
    End With

    ' 在汇总工作簿中创建新的工作表用于存放汇总数据
    Set destSheet = ThisWorkbook.Sheets.Add
    destSheet.Name = "汇总表"

    ' 初始化行号
    lastRow = 1

    ' 遍历文件夹中的所有文件
    fileName = Dir(folderPath & "*.xlsx")
    Do While fileName <> ""
        ' 打开工作簿
        Set workBk = Workbooks.Open(folderPath & fileName)

        ' 遍历每个工作表，检查是否为需要的工作表
        For i = 1 To workBk.Sheets.Count
            Select Case workBk.Sheets(i).Name
                Case "三步", "水迳", "水下"
                    ' 设置源工作表和目标工作表
                    Set sourceSheet = workBk.Sheets(i)
                    Set destSheet = ThisWorkbook.Sheets("汇总表")

                    ' 复制数据到汇总工作表，仅复制值，不复制公式
                    destSheet.Range("A" & lastRow).Resize(sourceSheet.Range("A15:I100").Rows.Count, sourceSheet.Range("A15:I100").Columns.Count).Value = sourceSheet.Range("A15:I100").Value

                    ' 在 A 列写入工作表名称
                    destSheet.Range("A" & lastRow, "A" & lastRow + sourceSheet.Range("A15:I100").Rows.Count - 1) = workBk.Sheets(i).Name

                    ' 提取标题并写入到 A1 行
                    destSheet.Range("A1:P1") = sourceSheet.Range("A15:P14").Value

                    ' 更新行号
                    lastRow = lastRow + sourceSheet.Range("A15:I100").Rows.Count
            End Select
        Next i

        ' 关闭工作簿，不保存更改
        workBk.Close savechanges:=False

        ' 获取下一个文件名
        fileName = Dir()
    Loop

    ' 清理
    Set workBk = Nothing
    Set sourceSheet = Nothing
    Set destSheet = Nothing

    ' 可选：自动调整汇总数据表的列宽
    ThisWorkbook.Sheets("汇总表").Columns.AutoFit

    MsgBox "数据汇总完成！", vbInformation, "完成"
End Sub

怎样把固定的工作表"三步", "水迳", "水下"改为动态引用汇总工作簿里面的班级表a列来获取我要提取的工作表？

ykcbf1100

AI写的代码就不要发了，不会有人去修改那个代码。
你就把需求说清楚就行了。

ykcbf1100

需求猜一下：只选取”成绩表.xlsx“中汇总表A列所列的工作表名的工作表，以便一步操作。如果是这样，用字典去固定这些表名就可以做到了。

tanglf188

是这个意思不？

458863601

tanglf188 发表于 2024-3-25 15:11
是这个意思不？

要提取这些表，如果在班级表设置，我要提取那个表就要那个工作表这样的功能。

458863601

ykcbf1100 发表于 2024-3-25 15:03
需求猜一下：只选取”成绩表.xlsx“中汇总表A列所列的工作表名的工作表，以便一步操作。如果是这样，用字典 ...

这样，代码怎样去设置啊？

ykcbf1100

458863601 发表于 2024-3-25 15:40
这样，代码怎样去设置啊？

你都没有具体要求，你也没有效果图，无法向下做。

458863601

ykcbf1100 发表于 2024-3-25 15:55
你都没有具体要求，你也没有效果图，无法向下做。

意思是根据文件夹中汇总表工作簿班级表a列的数据来选择我要提取的工作表，然后提取工作表指定的区域的数值。再把提取的数据汇总在一张表中。

ykcbf1100

458863601 发表于 2024-3-25 16:06
意思是根据文件夹中汇总表工作簿班级表a列的数据来选择我要提取的工作表，然后提取工作表指定的区域的数 ...

汇总表效果图呢？

458863601

ykcbf1100 发表于 2024-3-25 15:55
你都没有具体要求，你也没有效果图，无法向下做。

我添加你的QQ了，可以通过帮我看看吗？