2023年03月04日 16:30--浏览 ·
--喜欢 ·
--评论Dim wbname As StringPrivate Sub CommandButton获取_Click()'获取工作簿中包含的工作表With ThisWorkbook.Worksheets("名称列表") '清除原列表数据.Columns(1).ClearFormats.Columns(1).ClearContentsEnd WithWith ThisWorkbook.Worksheets("操作界面")If .Cells(2, "C").Value <> "" Thenwbname = .Cells(2, "C").ValueElseMsgBox "请输入工作簿名称（包含扩展名）"Exit SubEnd IfEnd WithDim i As IntegerFor i = 1 To Workbooks(wbname).Worksheets.CountThisWorkbook.Worksheets("名称列表").Cells(i + 1, 1).Value = Workbooks(wbname).Worksheets(i).NameThisWorkbook.Worksheets("名称列表").Cells(1, 1).Value = "工作表名称"Next iThisWorkbook.Worksheets("名称列表").ActivateEnd SubPrivate Sub CommandButton提取_Click()With ThisWorkbook.Worksheets("操作界面")If .Cells(2, "C").Value <> "" Thenwbname = .Cells(2, "C").ValueElseMsgBox "请输入工作簿名称（包含扩展名）"Exit SubEnd IfEnd WithDim addrow As LongWith ThisWorkbook.Worksheets("名称列表")Dim i As LongDim imax As LongDim j As LongDim jmax As LongDim shtname As Stringimax = .Cells(1000000, 1).End(xlUp).Rowjmax = ThisWorkbook.Worksheets("提取结果").Cells(1, 10000).End(xlToLeft).ColumnFor i = 2 To imaxIf .Cells(i, 1).Value <> "" Thenshtname = .Cells(i, 1).Valueaddrow = iWith ThisWorkbook.Worksheets("提取结果").Rows(i).ClearContents.Rows(i).ClearFormatsFor j = 1 To jmaxIf .Cells(1, j).Value <> "" Then.Cells(i, j).Value = Workbooks(wbname).Worksheets(shtname).Range(CStr(.Cells(1, j).Value))End IfNext jEnd WithEnd IfNext iMsgBox "处理完成"End WithThisWorkbook.Worksheets("提取结果").ActivateEnd SubPrivate Sub CommandButton生成_Click()Application.ScreenUpdating = FalseWith ThisWorkbook.Worksheets("操作界面")Dim wbname As StringIf .Cells(2, "C").Value <> "" Thenwbname = .Cells(2, "C").ValueElseMsgBox "请输入工作簿名称（包含扩展名）"Exit SubEnd IfEnd WithWith ThisWorkbook.Worksheets("名称列表")Dim i As LongDim imax As LongDim j As LongDim jmax As LongDim shtname As Stringimax = .Cells(1000000, 1).End(xlUp).Rowjmax = .Cells(1, 10000).End(xlToLeft).ColumnFor i = 2 To imaxIf .Cells(i, 1).Value <> "" Thenshtname = .Cells(i, 1).ValueThisWorkbook.Worksheets("模板").Copy after:=Workbooks(wbname).Worksheets(Workbooks(wbname).Worksheets.Count)Workbooks(wbname).Worksheets(Workbooks(wbname).Worksheets.Count).Name = shtnameWorkbooks(wbname).SaveFor j = 2 To jmaxIf .Cells(1, j).Value <> "" ThenWorkbooks(wbname).Worksheets(shtname).Range(CStr(.Cells(1, j).Value)) = .Cells(i, j).ValueEnd IfNext jEnd IfNext iMsgBox "处理完成"End WithWorkbooks(wbname).SaveApplication.ScreenUpdating = TrueEnd Sub}