有什么办法可以在VBA Excel中修复此循环?

玛丽·戈麦斯

我的Excel中只有几张纸。我希望此代码应用某些特定的工作表。由于我不擅长vba,因此无法执行。请有人帮我。我如何将Sheet3添加到此代码中的17,以便仅针对这些工作表运行代码。

Sub insertRowsSheets()
    ' Disable Excel properties before macro runs
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    ' Declare object variables
    Dim ws As Worksheet, iCountRows As Integer
    Dim activeSheet As Worksheet, activeRow As Long
    Dim startSheet As String
        
  ' State activeRow
    activeRow = ActiveCell.Row
    
 ' Save initial active sheet selection
    startSheet = ThisWorkbook.activeSheet.Name
               
    ' Trigger input message to appear - in terms of how many rows to insert
    iCountRows = Application.InputBox(Prompt:="How many rows do you want to insert, starting with row " _
    & activeRow & "?", Type:=1)
        
    ' Error handling - end the macro if a zero, negative integer or non-integer value is entered
    If iCountRows = False Or iCountRows <= 0 Then End
    
    ' Loop through the worksheets in active workbook
    For Each ws In ActiveWorkbook.Sheets
        ws.Activate
        Rows(activeRow & ":" & activeRow + iCountRows - 1).Insert
        Range("A9").Select
        Range("A8:C8").Select
        Selection.Copy
        Range("A9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        Range("D8:J8").Select
        Selection.AutoFill Destination:=Range("D8:J9")
        Range("D8:J9").Select
        Range("K8:L8").Select
        Selection.Copy
        Range("K9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        Range("M8:T8").Select
        Selection.AutoFill Destination:=Range("M8:T9")
        Range("M8:T9").Select
        Range("A8").Select
    Next ws
                            
    ' Move cursor back to intial worksheet
    Worksheets(startSheet).Select
    Range("A8").Select
                   
    ' Re-enable Excel properties once macro is complete
    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With                                     
End Sub
VBasic2008

更新工作表

  • 这应该和以前一样。
  • 至少它应该可以帮助您弄清楚如何遍历工作表名称数组而不是工作表集合。
  • 我无法弄清楚复制和填充的逻辑。您是否应该从活动行开始填充与用户选择的行一样多的行?

编码

Option Explicit

Sub insertRowsSheets()
    
    ' Define Worksheet Names Array.
    Dim wsNames As Variant ' Tab names, not code names.
    wsNames = Array("Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", _
                    "Sheet8", "Sheet9", "Sheet10", "Sheet11", "Sheet12", _
                    "Sheet13", "Sheet14", "Sheet15", "Sheet16", "Sheet17")
    
    ' Declare object variables
    Dim wb As Workbook
    Dim ws As Worksheet
    
    Dim RowsCount As Long
    Dim ActiveRow As Long
    Dim StartSheet As String
    Dim i As Long
        
    ' Define workbook.
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    ' State activeRow
    ActiveRow = ActiveCell.Row
    
    ' Trigger input message to appear - in terms of how many rows to insert
    RowsCount = Application.InputBox(Prompt:="How many rows do you want to insert, starting with row " _
    & ActiveRow & "?", Type:=1)
        
    ' Error handling - end the macro if a zero, negative integer or non-integer value is entered
    If RowsCount = False Or RowsCount <= 0 Then Exit Sub
    
    ' Loop through the worksheets.
    For i = LBound(wsNames) To UBound(wsNames)
        With wb.Worksheets(wsNames(i))
            .Rows(ActiveRow & ":" & ActiveRow + RowsCount - 1).Insert
            .Range("A9:C9").Value = .Range("A8:C8").Value
            .Range("D8:J8").AutoFill Destination:=.Range("D8:J9")
            .Range("K9:L9").Value = .Range("K8:L8").Value
            .Range("M8:T8").AutoFill Destination:=.Range("M8:T9")
        End With
    Next i
                   
End Sub

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章

有什么办法可以修复损坏的硬盘?

有什么办法可以在VBA中检查其数据类型的数据

有什么办法可以在HQL中执行此查询?

有什么办法可以解决此无效的模块名称错误?

有什么办法可以使此反应组件更简洁?

我有什么办法可以解决此if语句?

有什么办法可以优化此R代码?

有什么办法可以改善这个循环吗?

有什么办法可以在numpy的循环中插入列

有什么办法可以用Nim建立循环参考?

有什么办法可以将其更改为 for 循环?Python

有什么办法可以在 kubernetes 中查看 entrypont 命令

有什么办法可以在iOS中以编程方式断开呼叫

有什么办法可以在Elastic Search中匹配类似匹配

有什么办法可以在Python中打印** kwargs

有什么办法可以在Swift中引用当前模块?

有什么办法可以找到laravel中半径所在的位置

有什么办法可以在Vim中查看当前映射的键?

有什么办法可以取消Kivy中的UrlRequest?

有什么办法可以缩短C ++中的String类型?

有什么办法可以引用Java中的当前框架?

我有什么办法可以在Swift中捕获断言?

有什么办法可以改变React js中render的状态?

有什么办法可以在paintComponent中获取参数?

有什么办法可以在抖动中实现双缓冲?

有什么办法可以在LaTeX中定义变量?

有什么办法可以先在Haddock中描述函数参数?

有什么办法可以在docker stats中显示容器名称?

有什么办法可以“提交” Redux中的状态以释放内存?