Question

Предпосылка: Я автоматизирую процесс ручного ввода данных в продукт эмуляции терминала (BlueZone) с использованием VBA. Как пользователь переднего плана я имею ограниченные команды и снимаю данные с экрана (с экраном копирования и вставкой в Excel), чтобы сделать определения и остановить запуск в случае возникновения ошибки. Данные связаны со складскими запасами, и есть проблемы с соответствием - поэтому важно, чтобы были проверки, чтобы гарантировать целостность.

В настоящее время у меня есть рабочий l oop, но мне нужно, чтобы он повторялся каждые 10 строк. Другими словами, мне нужно:

1) Перейти к связанному экрану эмуляции

2) Введите данные заголовка

3) Введите 10 продуктов с корректировочными суммами - начать в строке 5

4) Зафиксировать запись

5) Начать снова с (1) в строке 15

Я попытался безуспешно:

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

user10129598 · Answer 1 · 27 апреля 2020

Мне удалось решить проблему:

(1) Формула листа для создания 1-10 счетчиков в столбце F

=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 для размещения итераций каждые 10 строк

Not самый красноречивый, но следующий код, выполненный без инцидентов:

'******************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

VBA L oop определенный диапазон для каждой n-й строки

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

VBA L oop определенный диапазон для каждой n-й строки

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Похожие темы