Question

我在线提取此代码，我是菜鸟，但我对循环进行了一些更改。请帮帮我！我想让这个宏在其他工作表上工作，保存到宏功能区。我已将其添加为加载项，已检查的安全设置，已检查的工具和参考。问题是如果我将它保存为我要拆分的excel文件下的模块，它可以工作，但是如果我将它保存在一张空白工作表中并将其拉为宏，这是我的团队使用的目标，宏拉出空白的原始纸张，将主人打成两半;保持活动表不受影响。

Sub Macrosplittest()
    Dim Sht As Worksheet
    Dim fName As String
    Dim ShtCountBk1 As Integer
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ShtCountBk1 = IIf(ActiveWorkbook.Sheets.Count Mod 2 = 1, Sheets.Count
  / 2 + 0.5, Sheets.Count / 2)
    Set neww = Workbooks.Add
    For Each Sht In ActiveWorkbook.Worksheets
        i = i + 1
        If i > ShtCountBk1 Then
            fName = Replace(ThisWorkbook.Name, ".xls", "")
            neww.SaveAs ThisWorkbook.Path & "\" & fName & " (1).xls"
            Set neww = Workbooks.Add
            i = 1
        End If
        Sht.Copy after:=Worksheets(neww.Sheets.Count)
        If i = 1 Then
           For Each ws In Worksheets
               If ws.Name <> Sht.Name Then
                   ws.Delete
               End If
           Next ws
        End If
    Next Sht
    fName = Replace(ThisWorkbook.Name, ".xls", "")
    neww.SaveAs ThisWorkbook.Path & "\" & fName & " (2).xls"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Answer 1

试试这个，我想我看到你要做的事情：

Sub Macrosplittest()
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False

        Dim Sht As Worksheet
        Dim fName As String
        Dim ShtCountBk1 As Integer
        Dim ws As Worksheet

        Dim wbActive as Workbook

        Dim newBook as Workbook

        Dim lHolder as Long
        Dim sHolder as String

        Dim i as Long

        Set wbActive = ActiveWorkbook

        lHolder = wbActive.Sheets.Count

        If lHolder Mod 2 = 1 Then
            ' This should evaluate just fine without parentheses, but I
            ' prefer to have the parentheses to make the code clear
            ShtCountBk1 = (lHolder / 2) + .05 
        Else
            ShtCountBk1 = lHolder / 2
        End IF

       Set newBook = Workbooks.Add

       For Each Sht In wbActive.Worksheets
           i = i + 1
           Sht.Name = "SHT-" & Sht.Name
           sHolder = Sht.Name

           If i > ShtCountBk1 Then
               fName = Replace(wbActive.Name, ".xls", "")
               newBook.SaveAs wbActive.Path & "\" & fName & " (1).xls"
               Set newBook= Workbooks.Add
               i = 1
           End If

           Sht.Copy after:=Worksheets(newBook.Sheets.Count)

           If i = 1 Then
              For Each ws In Worksheets
                   If ws.Name <> sHolder Then
                       ws.Delete
                   End If
               Next ws
           End If

       Next Sht

       fName = Replace(wbActive.Name, ".xls", "")
       newBook.SaveAs wbActive.Path & "\" & fName & " (2).xls"

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

我做了一些修改，使您的代码更易于阅读，并使其正确引用您要定位的工作簿。最好避免使用ActiveWorkbook，因为这会导致错误。此外，ThisWorkbook将引用运行代码的工作簿。我不确定当加载项调用ThisWorkbook时这是否会正确引用activeworkbook，但最好是谨慎行事。

如何让我的宏处理其他Excel工作表

1 个答案: