直到ActiveCell為空

Question

使用以下代碼，我試圖從XLS（initialVal）復制一個值並將其粘貼到GUI文本字段。 然后，我想進入一個循環並使用ActiveCell調用和偏移量（向下移動一行）來獲取下一個值（nextVal）。 我想繼續檢索（並將其粘貼到GUI）下一行（同一列）中的下一個值，直到找到一個空單元格為止。

使用下面我正在處理的代碼，它將粘貼初始值fine（2,7），但隨后會連續粘貼（以無限循環的形式）第一行/列，並且似乎不會通過這些值增加/偏移，即期望是：

(2,7) Initial Value
(3,7) Next Value
(4,7) Next Value
(5,7) Next Value
(6,7) Next Value etc etc until empty

Set objExcel = CreateObject("Excel.Application")
Set objWb = objExcel.Workbooks.Open("C:\test.xlsx")
Set objSheet = objWb.Worksheets("sheet1")

Set initialVal = objSheet.Cells(2, 7)

'At this point code (TBC, not required to highlight this issue) will paste the
'initialVal to a text field in the GUI and subsequently clear/delete the field

Sub test1()
    Set nextVal = ObjExcel.ActiveCell

    Do Until IsEmpty(nextVal)
        nextVal.Offset(1, 0).Select
        'Again, at this point the code will paste the nextVal to the GUI (and
        'subsequently clear it) , loop back and move down one cell and paste that
        'next cell until it hits an empty cell and come out of the loop
    Loop
End Sub

Call test1

Answer 1

我沒有改變邏輯。 只是糾正錯誤。

將您的子代碼重寫為：

Sub test1()
    initialVal.offset(1,0).Select         'You have to move 1 cell down from your initial cell  
    Set nextVal = objExcel.ActiveCell
    Do until IsEmpty(nextVal)

        '----------->GUI pasting code<---------------

        nextVal.Offset(1, 0).Select
        Set nextVal = objExcel.ActiveCell    
    Loop
End Sub

這是完成工作的另一種方法。 不需要選擇像元並一次又一次地偏移。 您可以直接從單元格中獲取所需的值。

Dim objExcel, objWb, objSheet, rows, i, tempVal
Set objExcel = CreateObject("Excel.Application")
Set objWb = objExcel.Workbooks.Open("C:\test.xlsx")
Set objSheet = objWb.Worksheets("sheet1")
rows = objSheet.usedrange.rows.count
for i=2 to rows step 1
    tempVal = objSheet.Cells(i,7)
    If IsEmpty(tempVal) then
        Exit For 
    Else
        'Call your function which pastes the tempVal to GUI
    End If  
Next
objWb.Close
objExcel.Quit
Set objSheet = Nothing
Set objWb = Nothing
Set objExcel = Nothing