Question

我有一个用户表单，用于向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

End Sub

Answer 1

你应该忘记循环并使用End（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

直到部分没有迭代

1 个答案: