Сценарий VB для цикла данных Excel по строке

Я работаю над сценарием VB, который собирает данные из Excel и вводит их на экран в мейнфрейме IBM 3270. С помощью приведенного ниже кода я могу открыть книгу Excel и скопировать данные по ячейкам, а затем ввести значение из выбранной ячейки на экран 3270, используя процедуры subEnterData и subMovecursor, которые я определил. Это отлично работает. Но, как вы можете видеть из моего кода ниже, я беру данные только из ячеек, расположенных в строке 2 объекта excel (строка 1 — это заголовки). Мне нужно получить данные из каждой ячейки в каждой строке, а затем перейти к следующей строке. Итак, после того, как строка 2 закончена, мне нужно перейти к строке 3, перейти к каждой ячейке в строке 3, скопировать данные из каждой ячейки и вставить их на экран в 3270, затем то же самое со строкой 4 и так далее. Их около 50 рядов, но их может быть больше или меньше.

Ниже приведена основная часть кода:

Option Explicit
Dim objExcel, objExcel1, objExcel2
Dim atlDirectorObject, oFileObject
Dim atl3270Tool 
Dim oMstrCmp 
Dim ErrMsg
'---------------------Excel Column Placement
Dim strLoanNumber
Sub subDoWork
subClearScreen
subGoToScreen "DELP", "********", ""
subStringExcelData
'subPressKey "@E"
    subMoveCursor 3, 7 
    subEnterData strLoanNumber_3_7
subPressKey "@E"
    subMoveCursor 11, 5 
    subEnterData strFlag_11_5
    subMoveCursor 11, 10
    subEnterData strDate_11_10
    subMoveCursor 11, 21
    subEnterData strINV_11_21
    subMoveCursor 11, 27
    subEnterData strCAT_11_27
    subMoveCursor 11, 35
    subEnterData strLPIDate_11_35
    subMoveCursor 11, 56
    subEnterData strEBalance_11_53
    subMoveCursor 11, 68
    subEnterData strNewLoanNumber_11_68
    subMoveCursor 13, 71
    subEnterData strINVBalance_13_68
    subMoveCursor 16, 7
    subEnterData strServiceFee_16_7
    subMoveCursor 21, 66
    subEnterData strADDLInvstor_21_66
subPressKey "@E" ' takes you to the second screen
    subMoveCursor 11, 76
    subEnterData strRemitCTRL_11_76
subPressKey "@E"  'Saves the data
End Sub
7 Dim strFlag_11_5 Dim strDate_11_10 Dim strINV_11_21 Dim strCAT_11_27 Dim strEBalance_11_53 Dim strLPIDate_11_35 Dim strNewLoanNumber_11_68 Dim strServiceFee_16_7 Dim strADDLInvstor_21_66 Dim strRemitCTRL_11_76 Dim strINVBalance_13_68 '---------------------Excel Column Placement Set atlDirectorObject = CreateObject("atlDirectorObject.atlDirector") Set oFileObject = CreateObject("Scripting.FileSystemObject") Set objExcel = createobject("Excel.Application") Set objExcel1 = objExcel.Workbooks.Open("S:\Scripting\0711_Settlement2.xlsx") Set objExcel2 = objExcel1.Worksheets("Import") subGetSession subDelpScreen 'objExcel1.Close 'objExcel.Quit Set objExcel = Nothing Set objExcel1 = Nothing Set objExcel2 = Nothing Set atlDirectorObject = Nothing Set oFileObject = Nothing Set atl3270Tool = Nothing

Вы можете видеть в subStringExcelData, что я вызываю объект и получаю значение:

Sub subStringExcelData
objExcel.Visible = True
strLoanNumber
Sub subDoWork
subClearScreen
subGoToScreen "DELP", "********", ""
subStringExcelData
'subPressKey "@E"
    subMoveCursor 3, 7 
    subEnterData strLoanNumber_3_7
subPressKey "@E"
    subMoveCursor 11, 5 
    subEnterData strFlag_11_5
    subMoveCursor 11, 10
    subEnterData strDate_11_10
    subMoveCursor 11, 21
    subEnterData strINV_11_21
    subMoveCursor 11, 27
    subEnterData strCAT_11_27
    subMoveCursor 11, 35
    subEnterData strLPIDate_11_35
    subMoveCursor 11, 56
    subEnterData strEBalance_11_53
    subMoveCursor 11, 68
    subEnterData strNewLoanNumber_11_68
    subMoveCursor 13, 71
    subEnterData strINVBalance_13_68
    subMoveCursor 16, 7
    subEnterData strServiceFee_16_7
    subMoveCursor 21, 66
    subEnterData strADDLInvstor_21_66
subPressKey "@E" ' takes you to the second screen
    subMoveCursor 11, 76
    subEnterData strRemitCTRL_11_76
subPressKey "@E"  'Saves the data
End Sub
7 = objExcel1.Worksheets("Import").Cells(2,1).Value strFlag_11_5 = objExcel1.Worksheets("Import").Cells(2,2).Value strDate_11_10 = objExcel1.Worksheets("Import").Cells(2,3).Value strINV_11_21 = objExcel1.Worksheets("Import").Cells(2,4).Value strCAT_11_27 = objExcel1.Worksheets("Import").Cells(2,5).Value strLPIDate_11_35 = objExcel1.Worksheets("Import").Cells(2,6).Value strEBalance_11_53 = objExcel1.Worksheets("Import").Cells(2,7).Value strNewLoanNumber_11_68 = objExcel1.Worksheets("Import").Cells(2,8).Value strServiceFee_16_7 = objExcel1.Worksheets("Import").Cells(2,9).Value strADDLInvstor_21_66 = objExcel1.Worksheets("Import").Cells(2,10).Value strRemitCTRL_11_76 = objExcel1.Worksheets("Import").Cells(2,11).Value strINVBalance_13_68 = objExcel1.Worksheets("Import").Cells(2,12).Value End Sub

Затем я использую subDoWork, чтобы найти нужное место на экране 3270 и вставить значение в нужное место. Это прекрасно работает, но мне нужно иметь возможность делать это со многими строками, и так, как я это сделал, в настоящее время я могу получить только одну строку за раз. Пожалуйста помоги!

Sub subDelpScreen содержит триггер для запуска subDoWork.

Sub subDoWork
subClearScreen
subGoToScreen "DELP", "********", ""
subStringExcelData
'subPressKey "@E"
    subMoveCursor 3, 7 
    subEnterData strLoanNumber_3_7
subPressKey "@E"
    subMoveCursor 11, 5 
    subEnterData strFlag_11_5
    subMoveCursor 11, 10
    subEnterData strDate_11_10
    subMoveCursor 11, 21
    subEnterData strINV_11_21
    subMoveCursor 11, 27
    subEnterData strCAT_11_27
    subMoveCursor 11, 35
    subEnterData strLPIDate_11_35
    subMoveCursor 11, 56
    subEnterData strEBalance_11_53
    subMoveCursor 11, 68
    subEnterData strNewLoanNumber_11_68
    subMoveCursor 13, 71
    subEnterData strINVBalance_13_68
    subMoveCursor 16, 7
    subEnterData strServiceFee_16_7
    subMoveCursor 21, 66
    subEnterData strADDLInvstor_21_66
subPressKey "@E" ' takes you to the second screen
    subMoveCursor 11, 76
    subEnterData strRemitCTRL_11_76
subPressKey "@E"  'Saves the data
End Sub

person UndergroundMan    schedule 24.07.2018    source источник
comment
Похоже, вам нужен цикл, а также подумать о том, чтобы немного привести код в порядок, используя аргументы метода вместо набора глобальных переменных (в частности, одноразовых - вы можете передать строку данных в subDoWork, и он может напрямую извлечь ценности).   -  person Tim Williams    schedule 25.07.2018


Ответы (1)


Не завершено и не проверено каким-либо образом, но должно дать вам некоторое представление о том, как действовать дальше:

Option Explicit

Dim objExcel, objExcelWb, objExcelSht
Dim atlDirectorObject, oFileObject
Dim atl3270Tool
Dim oMstrCmp
Dim ErrMsg

Main

Sub Main()
    Dim rwNum

    Set atlDirectorObject = CreateObject("atlDirectorObject.atlDirector")
    Set objExcel = CreateObject("Excel.Application")
    Set objExcelWb = objExcel.Workbooks.Open("S:\Scripting\0711_Settlement2.xlsx")
    Set objExcelSht = objExcelWb.Worksheets("Import")
    Set oFileObject = CreateObject("Scripting.FileSystemObject")

    rwNum = 2
    'starting at row 2, loop over the dataset until you hit an
    '   empty row (where CountA() = 0)
    Do While objExcel.CountA(objExcelSht.Rows(rwNum)) > 0
        'pass the row of data to subDoWork 
        subDoWork objExcelSht.Rows(rwNum)
        rwNum = rwNum + 1 ' next row...
    Loop

    'typically there's no need to set objects to Nothing unless
    '  there are associated resources you need to free up...
End Sub

Sub subDoWork(rw)
    subClearScreen
    subGoToScreen "DELP", "********", ""

    'subPressKey "@E"

    EnterValueAt 3, 7, rw.Cells(1).Value

    subPressKey "@E"

    EnterValueAt 11, 5, rw.Cells(2).Value
    EnterValueAt 11, 10, rw.Cells(3).Value
    EnterValueAt 11, 21, rw.Cells(4).Value
    'etc
    'etc

    subPressKey "@E" ' takes you to the second screen

    EnterValueAt 11, 76, rw.Cells(11).Value

    subPressKey "@E"  'Saves the data
End Sub

'Enter a value at a given set of coordinates
Sub EnterValueAt(pos1, pos2, v)
    subMoveCursor pos1, pos2
    subEnterData v
End Sub
person Tim Williams    schedule 24.07.2018
comment
Как вы думаете, вы могли бы объяснить, объяснить зацикливание с помощью rw = rw +1? В любом случае, код работает потрясающе. - person UndergroundMan; 27.07.2018
comment
@UndergroundMan — добавлено несколько комментариев и исправлено повторное использование имени переменной rw, приводящее к путанице. - person Tim Williams; 28.07.2018