vba - VBA 循环定义范围每 n 行
问题描述
前提：我正在使用 VBA 将手动数据输入过程自动化到终端仿真产品 (BlueZone) 中。作为前端用户，我有有限的命令并从屏幕上提取数据（使用复制屏幕并粘贴到 Excel 中）来做出决定并在遇到错误时停止运行。这些数据与仓库库存相关，并且存在合规性问题 - 因此进行检查以保证完整性很重要。
我目前有一个工作循环，但我需要它每 10 行迭代一次。换句话说，我需要它：
1) 导航到相关的仿真屏幕
2) 输入表头数据
3) 输入 10 个带有调整金额的产品 - 从第 5 行开始
4) 提交条目
5) 从第 15 行的 (1) 重新开始
我尝试过但没有成功：
For i = 1 to 3000 Step 10 '3000 same range defined as object in current for each
系统和用户录入表单截图：
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
尝试第 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) 在 F 列中创建 1-10 个计数的工作表公式
=IF(F5=10,1,F5+1)
(2) 用 vlookup 链接到 H 列中的屏幕位置
（3）G栏解读截图
=IFERROR(IF(SEARCH(B5,(IFERROR(VLOOKUP(F5,$H$11:$I$20,2,0),"")),1)>1,"PASS",""),"")
(3) For Each 中的 If 语句以适应每 10 行的迭代
不是最有说服力的，但以下代码毫无意外地执行了：
'******************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
推荐阅读
- javascript - 即使使用回调和 handleFunction，setState 也不会更新状态 - ReactJs
- tensorflow - 在 Keras 中将变压器输出连接到 CNN 输入的问题
- java - 如何迭代地创建和附加到 JSON 文件？
- scipy - 学生 cdf 和正常 ppf 精度
- c# - 在 DataTemplate 中使用时，行为 DependencyProperty 不更新 ViewModel
- sql - 输出数组类型列
- java - 用于转换器的 Spring Cloud AWS SQSListener 拦截器
- apache-nifi - 如何使用 jolt 从给定的字符串数组中删除匹配的元素？
- spring-boot - Spring数据和ElasticSearch，我如何搜索整个对象？
- javascript - 如何使用 JS 在 Illustrator 中获取路径上点的坐标？