做直到部分没有迭代

我有一个用于向Excel表单提交数据的用户表单，但除了序列号外，一切正常。它仅在第二次迭代后才会为每个条目返回相同的序列号。我不知道错误在哪里。请更正此代码。做直到部分没有迭代

Private Sub cmdSub_Click() 
Dim i As Integer 
'position cursor in the correct cell A2 
Range("A2").Select 
i = 1 'set as the first it 
'validate first three controls have been entered... 
If srv.txtTo.Text = Empty Then 'SRV no. for to 
MsgBox "Please Enter SRV NO.To", vbInformation 
srv.txtTo.SetFocus 'position cursor to try again 
Exit Sub 'terminate here - why continue? 
End If 

If srv.txtFrom.Text = Empty Then 'SRV no. for to 
MsgBox "Please Enter SRV NO.From", vbInformation 
srv.txtFrom.SetFocus 'position cursor to try again 
Exit Sub 'terminate here - why continue? 
End If 

If srv.txtLoc.Text = Empty Then 'SRV no. for to 
MsgBox "Please Enter SRV NO.To", vbInformation 
srv.txtLoc.SetFocus 'position cursor to try again 
Exit Sub 'terminate here - why continue? 
End If 

'if all the above are false (OK) then carry on. 
'check to see the next available blank row start at cell A2 
Do Until ActiveCell.Value = Empty 
    ActiveCell.Offset(1, 0).Select 'move down 1 row 
    i = 1 + 1 'keep a count of the ID for later use 
Loop 

'populate the new data values into the 'test' worksheet. 
ActiveCell.Value = i 'next ID Number 
ActiveCell.Offset(0, 1).Value = srv.txtTo.Text 'set col B 
ActiveCell.Offset(0, 2).Value = srv.txtFrom.Text 'set cl c 
ActiveCell.Offset(0, 3).Value = srv.txtLoc.Text 'set col c 

'clear down the values ready for the next record entry 
srv.txtTo.Text = Empty 
srv.txtFrom.Text = Empty 
srv.txtLoc.Text = Empty 

srv.txtTo.SetFocus ' positions the cursor for next work

末次

来源

2013-11-23 amarjeet.it

[有趣的阅读]（http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select） –

欢迎计算器@amarjeet。如果您得到了合适的答案，请记住将其标记为已接受。要将答案标记为已接受，请单击答案旁边的复选标记以将其从灰色变为填充。 – Reafidy

您应该忘记的循环和使用结束（xlUp）获得第一个可用的空白单元格。我还改变了获取新ID的方法，因为当删除一行时，旧方法可能会导致重复。

Private Sub cmdSub_Click() 

'validate first three controls have been entered... 
If srv.txtTo.Text = Empty Then 'SRV no. for to 
MsgBox "Please Enter SRV NO.To", vbInformation 
srv.txtTo.SetFocus 'position cursor to try again 
Exit Sub 'terminate here - why continue? 
End If 

If srv.txtFrom.Text = Empty Then 'SRV no. for to 
MsgBox "Please Enter SRV NO.From", vbInformation 
srv.txtFrom.SetFocus 'position cursor to try again 
Exit Sub 'terminate here - why continue? 
End If 

If srv.txtLoc.Text = Empty Then 'SRV no. for to 
MsgBox "Please Enter SRV NO.To", vbInformation 
srv.txtLoc.SetFocus 'position cursor to try again 
Exit Sub 'terminate here - why continue? 
End If 

'Get the first available blank cell in column A. 
With Range("A" & Rows.Count).End(xlUp).Offset(1) 
    'populate the new data values into the 'test' worksheet. 
    .Value = WorksheetFunction.Max(Range("A:A")) + 1 'next ID Number 
    .Offset(0, 1).Value = srv.txtTo.Text 'set col B 
    .Offset(0, 2).Value = srv.txtFrom.Text 'set cl c 
    .Offset(0, 3).Value = srv.txtLoc.Text 'set col c 
End With 

'clear down the values ready for the next record entry 
srv.txtTo.Text = Empty 
srv.txtFrom.Text = Empty 
srv.txtLoc.Text = Empty 

srv.txtTo.SetFocus ' positions the cursor for next work 
End Sub

来源

2013-11-24 00:05:14 Reafidy

做直到部分没有迭代

回答

相关问题