【问题标题】:Excel Macro Help - Stacking MacrosExcel 宏帮助 - 堆叠宏
【发布时间】:2010-12-14 06:40:24
【问题描述】:

我正在使用以下子例程将单个文件夹中的多个 Excel 文件合并到具有多个工作表的单个工作簿中。

Sub Merge2MultiSheets()

Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\MyPath" ' <-- Insert Absolute Folder Location
Set wbDst = Workbooks.Add(xlWBATWorksheet)
strFilename = Dir(MyPath & "\*.xls", vbNormal)

If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""            
    Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)                
    Set wsSrc = wbSrc.Worksheets(1)                
    wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)                
    wbSrc.Close False            
    strFilename = Dir()            
Loop
wbDst.Worksheets(1).Delete

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

最终产品是一个包含多个工作表(以及一个空白工作表 1)的 excel 文件。我想知道如何将另一个宏应用到这个新创建的工作簿。例如,我希望这个新工作簿中的所有工作表的标题都以某种方式加粗和着色,并删除空的工作表。

例如:

Sub Headers()

Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Interior
    .ColorIndex = 37
    .Pattern = xlSolid
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With

End Sub

【问题讨论】:

    标签: excel vba excel-2003


    【解决方案1】:
    Sheets.Select       'selects all sheets'
    Rows("1:1").Select
    Selection.Interior.ColorIndex = 37
    

    【讨论】:

    • iDevlop - 我同意这行得通,但我的意思是您必须对工作表引用进行硬编码,并且您假设只有三个名为 Sheet1、Sheet2 和 Sheet3 的工作表。为了使代码尽可能可重用(即处理不确定数量的工作表和名称),您无法避免循环通过工作表......
    • @Remnant:我同意你的反对意见。我现在没有时间,但我会尝试展示一个正确的方法。我很确定我前段时间通过参考第一张和最后一张纸(您可以识别)来做到这一点。只需要找到如何......或承认我错了;-)
    • 如果 VBA 有像 ActiveWorkbook.Worksheets.Group 这样的东西会有什么好处。顺便说一句,不要看这个谁对谁错……这是关于帮助彼此学习,如果你能告诉我一种更有效的编码方式,我会很高兴!
    • @Remnant:找到至少一种同时选择所有工作表的方法 :-))查看编辑
    【解决方案2】:

    向 Headers 添加一个参数,指定一个工作表,然后在复制后在 Do Loop 中的某处调用 sub,例如:

    Call Headers(wbDst.Worksheets(wbDst.Worksheets.Count))
    

    你的第二个子看起来像这样:

    Sub Headers(workingSheet As Worksheet)
    
    workingSheet.Rows("1:1").Select
    Selection.Font.Bold = True
    With Selection.Interior
    .
    .
    .
    

    【讨论】:

      【解决方案3】:

      此代码将执行以下操作:

      1) 首先,按照您在帖子中的要求删除Sheet1

      2) 格式化剩余工作表中的第一行

      Sub Headers()
      Dim wkSheet As Worksheet
      
      //Delete Sheet1. Note that alerts are turned off otherwise you are prompted with a dialog box to check you want to delete sheet1
      Application.DisplayAlerts = False
      Worksheets("Sheet1").Delete
      Application.DisplayAlerts = False
      
      //Loop through each worksheet in workbook sheet collection
      For Each wkSheet In ActiveWorkbook.Worksheets
          With wkSheet.Rows("1:1")
              .Interior.ColorIndex = 37
              //Add additional formatting requirements here
          End With
      Next
      
      End Sub
      

      【讨论】:

      • 无需遍历工作表。只需将它们分组,完成工作,然后取消分组。
      • @iDevlop - 你能给我看一些代码吗?要在 VBA 中分组,我认为您必须创建一组工作表,例如Sheets(Array("Sheet1", "Sheet2", "Sheet3")) 但在我看来,要做到这一点,您首先需要遍历工作簿中的每个工作表以创建数组?