简体   繁体   English

VBA遍历设置的行

[英]VBA to loop through set rows

I have the code below that updates data on the "Audit Sheet" with specific data from the "Master" sheet, prints the "Audit" sheet and loops until the last row is empty. 我下面的代码使用“主”表中的特定数据更新“审计表”上的数据,打印“审计”表并循环直到最后一行为空。 It works great for a small amount of data, but I have another project that will have over 1800 rows of data. 它适用于少量数据,但是我还有另一个项目,该项目将包含1800多行数据。 I don't want to clog up the printer with 1800 pages all at once. 我不想一次塞满1800页的打印机。

What I want is to be able to have a box pop up and specify the beginning row and ending row. 我想要的是能够弹出一个框并指定开始行和结束行。 I have done this before, but I have forgotten over the years of how I originally wrote the code. 我之前已经做过,但是多年来我一直忘记最初编写代码的方式。 Any help is appreciated. 任何帮助表示赞赏。

Sub testLoopPaste()

Dim i As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Master")
Set sht2 = wb.Sheets("Audit Sheet")

Application.ScreenUpdating = False

'Find the last row (in column A) with data.
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row

'This is the beginning of the loop
For i = 2 To LastRow
    'First activity
    sht2.Range("B1" & ii) = sht1.Range("B" & i).Value
    sht2.Range("B2" & ii) = sht1.Range("A" & i).Value
    sht2.Range("B3" & ii) = sht1.Range("N" & i).Value
    sht2.Range("H1" & ii) = sht1.Range("C" & i).Value
    sht2.Range("H2" & ii) = sht1.Range("I" & i).Value
    sht2.Range("H3" & ii) = sht1.Range("F" & i).Value
    sht2.Range("K1" & ii) = sht1.Range("D" & i).Value

    sht2.PrintOut

Next i

Application.ScreenUpdating = True

End Sub

You want to loop over a range object in a manner similar to 您想要以类似于以下方式的方式遍历范围对象

dim rngobj, userinputstart, userinputend as variant

set rngobj = Range(Range(userinputstart),Range(userinputend))
For each therow in rngobj
    'do stuff here
Next

Depending on how you grab user input you're going to have to fiddle with that part. 根据抓取用户输入的方式,您将不得不摆弄该部分。

Thank you to all who posted. 谢谢所有张贴的人。 I finally figured out what worked best. 我终于找出最有效的方法。 Here is my finished code and it works perfectly. 这是我完成的代码,它可以完美运行。

Sub testLoopPaste()

Dim i As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Master")
Set sht2 = wb.Sheets("Audit Sheet")

Application.ScreenUpdating = False
'Find the last row of data
LastRow = InputBox("Enter the last row of data", "End Row")

'This is the beginning of the loop
For i = InputBox("Enter the first row of data", "Start Row") To LastRow

    'First activity
    sht2.Range("B2" & ii) = sht1.Range("B" & i).Value
    sht2.Range("B4" & ii) = sht1.Range("C" & i).Value
    sht2.Range("B6" & ii) = sht1.Range("D" & i).Value
    sht2.Range("B8" & ii) = sht1.Range("L" & i).Value
    sht2.Range("B10" & ii) = sht1.Range("M" & i).Value
    sht2.Range("B12" & ii) = sht1.Range("N" & i).Value
    sht2.Range("B14" & ii) = sht1.Range("Q" & i).Value
    sht2.Range("B16" & ii) = sht1.Range("R" & i).Value
    sht2.Range("B18" & ii) = sht1.Range("AO" & i).Value
    sht2.Range("D2" & ii) = sht1.Range("J" & i).Value
    sht2.Range("D4" & ii) = sht1.Range("K" & i).Value
    sht2.Range("D6" & ii) = sht1.Range("O" & i).Value
    sht2.Range("D8" & ii) = sht1.Range("A" & i).Value
    sht2.Range("D10" & ii) = sht1.Range("AO" & i).Value
    sht2.Range("D12" & ii) = sht1.Range("T" & i).Value
    sht2.Range("D14" & ii) = sht1.Range("U" & i).Value
    sht2.Range("D16" & ii) = sht1.Range("V" & i).Value
    sht2.Range("D18" & ii) = sht1.Range("W" & i).Value
    sht2.Range("D20" & ii) = sht1.Range("X" & i).Value
    sht2.Range("D22" & ii) = sht1.Range("Y" & i).Value
    sht2.Range("D24" & ii) = sht1.Range("Z" & i).Value
    sht2.Range("D26" & ii) = sht1.Range("AA" & i).Value
    sht2.Range("D28" & ii) = sht1.Range("AB" & i).Value
    sht2.Range("D35" & ii) = sht1.Range("AT" & i).Value
    sht2.Range("D37" & ii) = sht1.Range("AV" & i).Value
    sht2.Range("D39" & ii) = sht1.Range("AX" & i).Value
    sht2.Range("D41" & ii) = sht1.Range("AZ" & i).Value
    sht2.Range("D43" & ii) = sht1.Range("BB" & i).Value
    sht2.Range("D45" & ii) = sht1.Range("BD" & i).Value
    sht2.Range("D47" & ii) = sht1.Range("BF" & i).Value
    sht2.Range("D49" & ii) = sht1.Range("BH" & i).Value
    sht2.Range("D51" & ii) = sht1.Range("BJ" & i).Value
    sht2.Range("D53" & ii) = sht1.Range("BL" & i).Value
    sht2.Range("D55" & ii) = sht1.Range("BN" & i).Value
    sht2.Range("I2" & ii) = sht1.Range("F" & i).Value
    sht2.Range("I4" & ii) = sht1.Range("G" & i).Value
    sht2.Range("I6" & ii) = sht1.Range("S" & i).Value
    sht2.Range("I8" & ii) = sht1.Range("AM" & i).Value
    sht2.Range("I10" & ii) = sht1.Range("AN" & i).Value
    sht2.Range("H12" & ii) = sht1.Range("AD" & i).Value
    sht2.Range("H14" & ii) = sht1.Range("AE" & i).Value
    sht2.Range("H16" & ii) = sht1.Range("AF" & i).Value
    sht2.Range("H18" & ii) = sht1.Range("AG" & i).Value
    sht2.Range("H20" & ii) = sht1.Range("AH" & i).Value
    sht2.Range("H22" & ii) = sht1.Range("AQ" & i).Value
    sht2.Range("H24" & ii) = sht1.Range("AI" & i).Value
    sht2.Range("H26" & ii) = sht1.Range("AJ" & i).Value
    sht2.Range("H28" & ii) = sht1.Range("AK" & i).Value
    sht2.Range("H30" & ii) = sht1.Range("AL" & i).Value
    sht2.Range("H35" & ii) = sht1.Range("AU" & i).Value
    sht2.Range("H37" & ii) = sht1.Range("AW" & i).Value
    sht2.Range("H39" & ii) = sht1.Range("AY" & i).Value
    sht2.Range("H41" & ii) = sht1.Range("BA" & i).Value
    sht2.Range("H43" & ii) = sht1.Range("BC" & i).Value
    sht2.Range("H45" & ii) = sht1.Range("BE" & i).Value
    sht2.Range("H47" & ii) = sht1.Range("BG" & i).Value
    sht2.Range("H49" & ii) = sht1.Range("BI" & i).Value
    sht2.Range("H51" & ii) = sht1.Range("BK" & i).Value
    sht2.Range("H53" & ii) = sht1.Range("BM" & i).Value
    sht2.Range("H55" & ii) = sht1.Range("BO" & i).Value

sht2.PrintOut

Next i

Application.ScreenUpdating = True

End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM