做直到部分沒有迭代

我有一個用於向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

做直到部分沒有迭代

回答

相關問題