vba 执行直到 ActiveCell 为空
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/44330140/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Do Until ActiveCell is empty
提问by CodeSpy
With the below code I am trying to copy a value from an XLS (initialVal) and paste to a GUI text field. Then, I want to enter a loop and get the next value (nextVal) using the ActiveCellcall and offset (move down one row).
I want to keep retrieving(and pasting to GUI) the next value in the next row (same column) until it finds an empty cell.
使用下面的代码，我试图从 XLS (initialVal) 复制一个值并粘贴到 GUI 文本字段。然后，我想进入一个循环并使用ActiveCell调用和偏移量（向下移动一行）获取下一个值（nextVal ）。我想继续检索（并粘贴到 GUI）下一行（同一列）中的下一个值，直到找到一个空单元格。
With the code below that I am working on, it pastes the initial value fine (2,7), but then it continually pastes (in an endless loop) the first row/column and doesn't seem to increment/offset through the values, i.e. The expectation is:
使用下面我正在处理的代码，它可以很好地粘贴初始值 (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
回答by Potatoツ
I am not changing anything in the logic. Just correcting the mistake.
我没有改变逻辑中的任何东西。只是纠正错误。
Rewrite your sub as:
将您的子文件重写为：
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
Here's another way to achieve the job. It does not require to select the cells and do the offset again and again. You can directly fetch the required values from the cells.
这是完成工作的另一种方法。它不需要选择单元格并一次又一次地进行偏移。您可以直接从单元格中获取所需的值。
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
