堆栈内存溢出
  简体   繁体   English

VBA 每n行循环定义范围

[英]VBA Loop Defined Range Every nth Row

 原文  2020-04-24 15:14:43  4   1    vba/ loops/ emulation/ nested-loops/ bluezone

问题描述

Premise: I am automating a manual data entry process into a terminal emulation product (BlueZone) using VBA. As a front-end user I have limited commands and lift data from the screen (with a copy screen and paste into Excel) to make determinations and stop the run if an error is encountered.前提：我正在使用 VBA 将手动数据输入过程自动化到终端仿真产品 (BlueZone) 中。作为前端用户，我的命令有限并从屏幕上提取数据（使用复制屏幕并粘贴到 Excel 中）来做出决定如果遇到错误，则停止运行。 The data is related to warehouse inventory and there are compliance issues - so it is important there are checks to guarantee integrity.数据与仓库库存相关，存在合规性问题 - 因此进行检查以保证完整性非常重要。

I currently have a working loop, but I need it to iterate every 10 rows.我目前有一个工作循环，但我需要它每 10 行迭代一次。 In other words, I need it to:换句话说，我需要它：

1) Navigate to the associated emulation screen 1) 导航到相关的仿真屏幕

2) Enter the header data 2）输入header数据

3) Enter 10 products with adjustment amounts - start at row 5 3) 输入 10 个带有调整金额的产品 - 从第 5 行开始

4) Commit the entry 4）提交条目

5) Begin again at (1) at row 15 5) 再次从第 15 行的 (1) 处开始

I have attempted without success:我尝试没有成功：

For i = 1 to 3000 Step 10 '3000 same range defined as object in current for each

Screenshots of the system and user entry form:系统截图和用户录入表：

仿真屏幕

输入和屏幕检查

Sub IISAB_DuuEet()

Dim bzhao As Object
Set bzhao = CreateObject("BZWhll.WhllObj")
bzhao.Connect ""

Dim myLoc, Prod, Adj_Dir, Adj_Qty As Variant
Dim RC As String 'Reason Code
Dim Julian As Integer 'Julian Date

Dim myRange As Range
Set myRange = Worksheets("Inventory_Adjustment").Range("A5:A3000") 'Entire range

RC = Sheets("Inventory_Adjustment").Range("A2").Value
Julian = Sheets("Inventory_Adjustment").Range("B2").Value

'--------------------------------------BLOCK 1----------------------------------------------

'********BLOCK 1 must occur only when i=1 of 10********'

'Navigar a IISAB y preparate
bzhao.SendKey "<PF3>"
bzhao.Wait 0.2
bzhao.SendKey "IISAB"
bzhao.Wait 0.2
bzhao.SendKey "<ENTER>"
bzhao.Wait 0.2
bzhao.SendKey "A"
bzhao.Wait 0.2
bzhao.SendKey RC
bzhao.Wait 0.2
bzhao.SendKey "<TAB>"
bzhao.Wait 0.2
bzhao.SendKey Julian
bzhao.Wait 0.2
bzhao.SendKey "<TAB><TAB><TAB><TAB>"

'--------------------------------------BLOCK 2----------------------------------------------

'********BLOCK 2 must occur for all i = 1 to 10********'

'Begin L00P on location>Prod>(+/-)>Qty 10x
For Each myLoc In myRange

'Si hay un blanco ya
    If myLoc = "" Then
        Exit For
            End If

Prod = myLoc.Offset(0, 1).Value
Adj_Dir = myLoc.Offset(0, 2).Value
Adj_Qty = myLoc.Offset(0, 3).Value


'Begin adjusts
bzhao.SendKey myLoc
bzhao.Wait 0.2
bzhao.SendKey "<TAB>"
bzhao.Wait 0.5

'Check product
bzhao.Copy 32
Range("I1").Select
ActiveSheet.Paste
bzhao.Wait 0.2

        'First flag "ERROR" on screen
        If Range("D1").Value = "ERROR" Then
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
            Exit For
                End If

            'Second flag product match what populated for the location
            If myLoc.Offset(0, 6).Value = "PASS" Then

            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Qty
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Dir
            bzhao.Wait 0.2
            myLoc.Offset(0, 4).Value = "ENTERED"

            Else 'ERROR, bomb out
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
                Exit For
                    End If

Next myLoc

'After 10th iteration -
'1) Commit inventory adjustments
'2) Start i=1 again with Block 1 and enter 10 more products

'--------------------------------------------------------------------------------------

End Sub

Attempt with Step 10 - I removed the working For Each.尝试第 10 步 - 我删除了 For Each 的工作。

Sub IISAB_DuuEet2()

Dim bzhao As Object
Set bzhao = CreateObject("BZWhll.WhllObj")
bzhao.Connect ""

Dim myLoc, Prod, Adj_Dir, Adj_Qty As Variant
Dim RC As String 'Reason Code
Dim Julian As Integer 'Julian Date

Dim myRange As Range
Set myRange = Worksheets("Inventory_Adjustment").Range("A5:A3000") 'Entire range

RC = Sheets("Inventory_Adjustment").Range("A2").Value
Julian = Sheets("Inventory_Adjustment").Range("B2").Value

'--------------------------------------------------------------------------------------

'--------------------------------------------------------------------------------------

'Begin L00P on location>Prod>(+/-)>Qty 10x
For i = 1 To 3000 Step 10

myLoc = Cells(i, 0).Value 'DEBUG object define error

'Si hay un blanco ya
    If myLoc = "" Then
        Exit For
            End If

        If i = 1 Then 'Enter screen info AND first line

        bzhao.SendKey "<PF3>"
        bzhao.Wait 0.2
        bzhao.SendKey "IISAB"
        bzhao.Wait 0.2
        bzhao.SendKey "<ENTER>"
        bzhao.Wait 0.2
        bzhao.SendKey "A"
        bzhao.Wait 0.2
        bzhao.SendKey RC
        bzhao.Wait 0.2
        bzhao.SendKey "<TAB>"
        bzhao.Wait 0.2
        bzhao.SendKey Julian
        bzhao.Wait 0.2
        bzhao.SendKey "<TAB><TAB><TAB><TAB>"


        Prod = myLoc.Offset(0, 1).Value
        Adj_Dir = myLoc.Offset(0, 2).Value
        Adj_Qty = myLoc.Offset(0, 3).Value


        'Begin adjusts
        bzhao.SendKey myLoc
        bzhao.Wait 0.2
        bzhao.SendKey "<TAB>"
        bzhao.Wait 0.5

        'Check product
        bzhao.Copy 32
        Range("I1").Select
        ActiveSheet.Paste
        bzhao.Wait 0.2

        'First flag "ERROR" on screen
        If Range("G2").Value = "ERROR" Then
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
            Exit For
                End If

            'Second flag product match what populated for the location
            If myLoc.Offset(0, 6).Value = "PASS" Then

            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Qty
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Dir
            bzhao.Wait 0.2
            myLoc.Offset(0, 4).Value = "ENTERED"

            Else 'ERROR, bomb out
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
                Exit For
                    End If


End If 'end i=1 if

        Prod = myLoc.Offset(0, 1).Value
        Adj_Dir = myLoc.Offset(0, 2).Value
        Adj_Qty = myLoc.Offset(0, 3).Value


        'Begin adjusts
        bzhao.SendKey myLoc
        bzhao.Wait 0.2
        bzhao.SendKey "<TAB>"
        bzhao.Wait 0.5

        'Check product
        bzhao.Copy 32
        Range("I1").Select
        ActiveSheet.Paste
        bzhao.Wait 0.2

        'First flag "ERROR" on screen
        If Range("G2").Value = "ERROR" Then
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
            Exit For
                End If

            'Second flag product match what populated for the location
            If myLoc.Offset(0, 6).Value = "PASS" Then

            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Qty
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Dir
            bzhao.Wait 0.2
            myLoc.Offset(0, 4).Value = "ENTERED"

            Else 'ERROR, bomb out
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("Error")
                Exit For
                    End If


Next i

'--------------------------------------------------------------------------------------

End Sub

1 个解决方案

解决方案1
 0  2020-04-27 15:46:31

I was able to solve the problem by:我能够通过以下方式解决问题：

(1) Sheet formula to create 1-10 counts in column F (1) 在 F 列中创建 1-10 个计数的工作表公式

=IF(F5=10,1,F5+1)

(2) Link with vlookup to the screen position in column H (2)用vlookup链接到H列的屏幕position

(3) Column G interprets the screenshots （3）G栏解读截图

=IFERROR(IF(SEARCH(B5,(IFERROR(VLOOKUP(F5,$H$11:$I$20,2,0),"")),1)>1,"PASS",""),"")

(3) If statements within the For Each to accommodate the iterations every 10 rows (3) For Each 中的 If 语句以容纳每 10 行的迭代

Not the most eloquent, but the following code executed without incident:不是最 eloquent，而是执行以下代码没有发生意外：

'******************INVENTORY USER +++ IISAB ADJUSTMENT******************'
'                                                                       '
'                                                                       '
'                                                                       '
'           Userform to complete Bucket List counts and capture         '
'            adjustments with direction for entry into IISAB.           '
'                                                                       '
'                        1337___734|\/| 1|)-10-T                        '
'                                                                       '
'                        Code by: Adam Kowaleski                        '
'                                                                       '
'                                                                       '
'                                                                       '
'*******************************//X//***********************************'

Sub IISAB_DuuEet4()

'Clear output
Range("E5:E1005").Select
Selection.ClearContents

Dim bzhao As Object
Set bzhao = CreateObject("BZWhll.WhllObj")
bzhao.Connect ""

Dim myLoc, Prod, Adj_Dir, Adj_Qty As Variant
Dim RC As String 'Reason Code
Dim Julian, kownt As Integer 'Julian Date

Dim myRange As Range
Set myRange = Worksheets("Inventory_Adjustment").Range("A5:A3000") 'Entire range

RC = Sheets("Inventory_Adjustment").Range("A2").Value
Julian = Sheets("Inventory_Adjustment").Range("B2").Value


'-----------------------------------------------------------------*

'Begin L00P on location>Prod>(+/-)>Qty 10x
For Each myLoc In myRange

'Si hay un blanco ya
    If myLoc = "" Then
        Exit For
            End If

Prod = myLoc.Offset(0, 1).Value
Adj_Dir = myLoc.Offset(0, 2).Value
Adj_Qty = myLoc.Offset(0, 3).Value
Scrn_Pos = myLoc.Offset(0, 5).Value

If Scrn_Pos = 1 Then 'Include screen nav --------------------------* 1 *

'Navigar a IISAB y preparate
bzhao.SendKey "<PF3>"
bzhao.Wait 0.2
bzhao.SendKey "IISAB"
bzhao.Wait 0.2
bzhao.SendKey "<ENTER>"
bzhao.Wait 0.2
bzhao.SendKey "A"
bzhao.Wait 0.2
bzhao.SendKey RC
bzhao.Wait 0.2
bzhao.SendKey "<TAB>"
bzhao.Wait 0.2
bzhao.SendKey Julian
bzhao.Wait 0.2
bzhao.SendKey "<TAB><TAB><TAB><TAB>"

'Begin adjusts
bzhao.SendKey myLoc
bzhao.Wait 0.2
bzhao.SendKey "<TAB>" 'Land on Product
bzhao.Wait 0.5

'Check product
bzhao.Copy 32
Range("I1").Select
ActiveSheet.Paste
bzhao.Wait 0.2

        'First flag "ERROR" on screen
        If Range("D1").Value = "ERROR" Then
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("EXE ERROR")
            Exit For
                End If

            'Second flag product match what populated for the location
            If myLoc.Offset(0, 6).Value = "PASS" Then

            bzhao.SendKey "<TAB>" 'Land on Adj Qty
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Qty
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>" 'Land on Adj Dir
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Dir
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>" 'Land on new loc
            myLoc.Offset(0, 4).Value = "ENTERED"

            Else 'ERROR, bomb out
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("PRODUCT DOES NOT MATCH")
                Exit For
                    End If

Else

'-----------------------------------------------------------* <> 1 *

'Begin adjusts
bzhao.SendKey myLoc
bzhao.Wait 0.2
bzhao.SendKey "<TAB>" 'Product
bzhao.Wait 0.5

'Check product
bzhao.Copy 32
Range("I1").Select
ActiveSheet.Paste
bzhao.Wait 0.2

        'First flag "ERROR" on screen
        If Range("D1").Value = "ERROR" Then
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("EXE ERROR")
            Exit For
                End If

            'Second flag product match what populated for the location
            If myLoc.Offset(0, 6).Value = "PASS" Then

            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Qty
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>"
            bzhao.Wait 0.2
            bzhao.SendKey Adj_Dir
            bzhao.Wait 0.2
            bzhao.SendKey "<TAB>" 'Next myLoc
            myLoc.Offset(0, 4).Value = "ENTERED"

                If Scrn_Pos = 6 Then
                bzhao.Wait 0.2
                bzhao.SendKey "<CursorLeft>" 'BECAUSE YES EXE THREW THAT WRENCH
                bzhao.Wait 0.2
                End If

            Else 'ERROR, bomb out
            myLoc.Offset(0, 4).Value = "ERROR"
            MsgBox ("PRODUCT DOES NOT MATCH")
                Exit For
                    End If

                If Scrn_Pos = 10 Then 'Commit at 10 '----* = 10 *
                bzhao.Wait 0.2
                bzhao.SendKey "<ENTER>"
                bzhao.Wait 0.2
                bzhao.SendKey "Y"
                bzhao.SendKey "<ENTER>"
                bzhao.Wait 1
                bzhao.SendKey "<DELETE>"
                bzhao.Wait 0.2
                bzhao.SendKey "<DELETE>"
                bzhao.Wait 0.2
                End If


End If 'Scrn_Pos = 1

Next myLoc


End Sub

暂无
暂无

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

相关问题 如何迭代每n行并再次循环？ - How to iterate every nth row and loop again? VBA 代码在特定范围内的每一行中循环，但循环必须在下一行开始一个新条件 - VBA code to loop in each row within a specific range, but the loop must start a new criteria in every next row 每行中的 Sumifs vba 循环 - Sumifs vba loop in every row 对于每个第N行的每个循环并包括最后一行 - For Each loop every Nth row and include the last row VBA-excel在数据集中的第n行插入一个新单元格 - VBA-excel inserting a new cell every nth row in a dataset 真的有可能为第n行绘制Excel VBA图吗 - Is it really possible to plot excel vba graph for every nth row 在 Excel VBA 中循环用户定义的范围 - Loop through a user defined Range In Excel VBA 将第N行的行复制/粘贴到新表中吗？ - Loop Copy/Paste every Nth row into new sheet? 范围错误-循环以增加行索引vba - Range Error - Loop to increase row index vba 在 VBA 中使用循环删除范围并每次迭代更改范围 - Using loop in VBA to delete a range and changing the range every iteration
相关标签
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM