时间戳

首页 > 解决方案 > 如何根据单元格值循环？

excel - 如何根据单元格值循环？

问题描述

此代码旨在根据单元格值复制和粘贴 x 次。

它会出错并且不会停止循环。
当我踏入它时，它会运行一次并停止。

“O7”是我想复制和粘贴多少次。

Sub WorksheetLoop()
Dim NS As Integer
NS = Sheets("Dashboard").Range("O7").Value
i = 1

Do

    Sheets("Dashboard").Select
    Sheets("Dashboard").Range("A9").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Archive").Select
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
        
    i = i + 1

Loop Until i = NS
                    
MsgBox "loop Complete"
        
End Sub

标签： excelvbado-loops

解决方案

工作表循环

提示

  • 阅读此处了解如何避免使用Select.
  • 如果范围始终相同，请将其置于循环之外（之前）。
  • 使用变量。
  • 尽可能少地访问每个工作表。
  • 请注意我如何使用i( i = 0 by default)：仅在复制后增加。在您的解决方案中，不会复制范围的最后一个实例。

编码

Option Explicit

Sub WorksheetLoop()
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim i As Long
    
    Dim dst As Worksheet
    Set dst = wb.Worksheets("Archive")
    Dim cel As Range
    
    Dim src As Worksheet
    Set src = wb.Worksheets("Dashboard")
    Dim NS As Long
    NS = src.Range("O7").Value
    Dim rng As Range
    Set rng = src.Range("A9", src.Range("A9").End(xlDown))
    Set rng = rng.SpecialCells(xlCellTypeVisible)
    
    Application.ScreenUpdating = False
        
    rng.Copy
    
    Do
        Set cel = dst.Cells(dst.Rows.Count, "A").End(xlUp).Offset(1)
        cel.PasteSpecial xlPasteValues
        i = i + 1
    Loop Until i = NS
    
    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True
    
    MsgBox "loop Complete", vbInformation, "Success"
            
End Sub

推荐阅读