您好我有一个VB链接到我以前的IT人员完成的Excel表格。现在它显示错误“结束如果没有阻止如果”。请帮我调试。代码如下。谢谢大家。
Private EditingRow As String
Private gCurrentStatus As String
Private gLocation As String
Private gRack As String
Private Sub cboType_Change()
cboSerialNo.Clear
Application.ScreenUpdating = False
Sheets("SGS Cylinder List").Select
ActiveSheet.Unprotect
ActiveSheet.UsedRange.Select
Selection.Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Set rng = Columns("D")
txtTotalSelectedType.Value = WorksheetFunction.countIF(rng, cboType.Value)
''' List all the selected Serial No
firstRowfound = False
firstrow = 0
lastRow = 0
Range("D1").Select
Do Until ActiveCell.Value = ""
If (firstRowfound = False And Cells(ActiveCell.Row, 4).Value = cboType.Value) Then
'MsgBox "1st row =" & ActiveCell.Row
firstrow = ActiveCell.Row
firstRowfound = True
End If
If (firstRowfound) Then
cboSerialNo.AddItem Trim(Cells(ActiveCell.Row, 3).Value) & " ," & Trim(Cells(ActiveCell.Row, 11))
End If
If (firstRowfound And Cells(ActiveCell.Row + 1, 4).Value <> cboType.Value) Then
'MsgBox "last row =" & ActiveCell.Row
lastRow = ActiveCell.Row
lastRowFound = True
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
If (firstrow > 0) Then
Set rngSelectedStatus = Range("I" & firstrow & ":I" & lastRow)
txtTotalCylinderAvailable.Value = WorksheetFunction.countIF(rngSelectedStatus, "Available")
Else
txtTotalCylinderAvailable.Value = 0
End If
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub
Private Sub cmdAdvancedAnalysis_Click()
If cboType.Value = "" Then
Exit Sub
End If
Worksheets("SGS Cylinder List").Select
ActiveSheet.Unprotect
newAddr = Sheets("SGS Cylinder List").[A2].CurrentRegion.Address(ReferenceStyle:=xlR1C1)
Sheets("Advanced").PivotTableWizard SourceType:=xlDatabase, SourceData:="SGS Cylinder List!" & newAddr
Sheets("Advanced").PivotTables("PivotTable1").RefreshTable
' Filter the PivotTable with the new Cylinder Type
Sheets("Advanced").PivotTables("PivotTable1").PageFields("Type").CurrentPage = cboType.Value
End Sub
Private Sub cmdCreateCylinder_Click()
Dim form1 As frmCylinder
Set form1 = New frmCylinder
form1.Show
End Sub
Private Sub cmdDisposalDate_Click()
Dim form1 As frmSelectDate
Set form1 = New frmSelectDate
form1.Show
Me.txtRsltDisposalDate = form1.SelectedDate
End Sub
Private Sub cmdLastUpdate_Click()
Dim form1 As frmSelectDate
Set form1 = New frmSelectDate
form1.Show
Me.txtLastUpdate.Value = form1.SelectedDate
End Sub
Private Sub cmdSearch_Click()
Sheets("SGS Cylinder List").Select
Range("C2").Select
Debug.Print cboSerialNo.Value
If cboSerialNo.Value = "" Then
Exit Sub
End If
cmdUpdate.Enabled = True
Do Until ActiveCell.Value = ""
' Found the row contains this given Serial No
''' to check the cboSerialNo first
serialNo = Left(cboSerialNo.Value, InStr(cboSerialNo.Value, ",") - 2)
If CStr(ActiveCell.Value) = serialNo Then
EditingRow = ActiveCell.Row
ActiveCell.EntireRow.Select
''' Show Selection
' Populate Location List
cboLocation.Clear
Sheets("Location").Select
Range("A2").Select
Do Until ActiveCell.Value = ""
cboLocation.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select
If CStr(ActiveCell.Value) = serialNo Then
EditingRow = ActiveCell.Row
ActiveCell.EntireRow.Select
cboRack.Clear
Sheets("Location").Select
Range("B2").Select
Do Until ActiveCell.Value = ""
cboRack.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
End If
Sheets("SGS Cylinder List").Select
If (Cells(ActiveCell.Row, 1).Value <> "") Then
cboLocation.Value = Cells(ActiveCell.Row, 1).Value
End If
If (Cells(ActiveCell.Row, 1).Value <> "") Then
cboRack.Value = Cells(ActiveCell.Row, 1).Value
End If
txtRsltClientName.Value = Cells(ActiveCell.Row, 5).Value
txtRsltWell.Value = Cells(ActiveCell.Row, 6).Value
txtRsltJobID.Value = Cells(ActiveCell.Row, 7).Value
''' Populate Sample Type List
cboRsltSampleType.Clear
Set sampleTypeList = Range("SampleTypes")
For Each cell In sampleTypeList
cboRsltSampleType.AddItem cell.Value
Next
If (Cells(ActiveCell.Row, 8).Value <> "") Then
cboRsltSampleType.Value = Cells(ActiveCell.Row, 8).Value
End If
txtRsltDisposalDate.Value = Cells(ActiveCell.Row, 9).Value
' Set Existing Cylinder Status
cboRsltCylinderStatus.Clear
Set statusList = Range("StatusTypes")
For Each cell In statusList
cboRsltCylinderStatus.AddItem cell.Value
Next
If (Cells(ActiveCell.Row, 10).Value <> "") Then
cboRsltCylinderStatus.Value = Cells(ActiveCell.Row, 10).Value
End If
''' Save Current Row of Cylinder Data to Global variables
gLocation = Cells(ActiveCell.Row, 1).Value
gRack = Cells(ActiveCell.Row, 2).Value
gClientName = Cells(ActiveCell.Row, 5).Value
gWell = Cells(ActiveCell.Row, 6).Value
gJobID = Cells(ActiveCell.Row, 7).Value
gSampleType = Cells(ActiveCell.Row, 8).Value
gCurrentStatus = Cells(ActiveCell.Row, 10).Value
Exit Sub
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Private Sub cmdUpdate_Click()
''' 1. Save the current setting to a History Sheet if found changes made
''' 2. Update the current row
'' if any property of the Cylinder change
If ((gCurrentStatus <> cboRsltCylinderStatus.Value _
Or gLocation <> cboLocation.Value _
Or gWell <> txtRsltWell.Value _
Or gJobID <> txtRsltJobID.Value _
Or gSampleType <> cboRsltSampleType.Value) _
And EditingRow <> "") Then
Range("LastUpdateDate").Value = Date
Sheets("SGS Cylinder List").Select
ActiveSheet.Unprotect
' Copy that edited range
Range("A" & EditingRow & ":I" & EditingRow).Select
Selection.Copy
'' Check if Cylinder Status change
If gCurrentStatus <> cboRsltCylinderStatus.Value Then
Sheets("History List").Select
Range("A" & ActiveSheet.Rows.Count).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
' Add a Current Status
Cells(ActiveCell.Row, 10).Value = cboRsltCylinderStatus.Value
' Add a Modified Date
If txtLastUpdate = "" Then
txtLastUpdate = Date
End If
Cells(ActiveCell.Row, 11).Value = txtLastUpdate
Cells(ActiveCell.Row, 11).NumberFormat = "dd-mmm-yy"
''' End of Step 1
End If
''' Start updating new changes
Sheets("SGS Cylinder List").Select
''' Add a New Location
If (txtRsltLocation.Value <> "" And cboLocation.Value = "") Then
Sheets("Location").Select
Range("A" & ActiveSheet.Rows.Count).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = txtRsltLocation.Value
Sheets("SGS Cylinder List").Select
Cells(EditingRow, 1).Value = txtRsltLocation.Value
Else
Cells(EditingRow, 1).Value = cboLocation.Value
End If
Cells(EditingRow, 5).Value = txtRsltClientName.Value
Cells(EditingRow, 6).Value = txtRsltWell.Value
Cells(EditingRow, 7).Value = txtRsltJobID.Value
Cells(EditingRow, 8).Value = cboRsltSampleType.Value
Cells(EditingRow, 9).Value = txtRsltDisposalDate.Value
Cells(EditingRow, 10).Value = cboRsltCylinderStatus.Value
End If
''' Reset
cboRsltCylinderStatus.Value = ""
cboLocation.Value = ""
txtRsltClientName.Value = ""
txtRsltWell.Value = ""
txtRsltJobID.Value = ""
cboRsltSampleType.Value = ""
txtRsltDisposalDate.Value = ""
cboRsltCylinderStatus.Value = ""
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub UserForm_Initialize()
Set typeList = Range("CylinderTypes")
For Each cell In typeList
cboType.AddItem cell.Value
Next
End Sub
非常感谢任何帮助。谢谢
答案 0 :(得分:1)
End If
ActiveCell.Offset(1, 0).Select
Loop
开头的End If
存在错误原因,因为它与开始If
语句不对应。您的意思是在代码中添加Else If
吗?
更新:我看到了这段代码:
Do Until ActiveCell.Value = ""
cboLocation.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select
没有相应的Loop
关键字,它与我上面提到的End If
的范围相同,这可能是关闭了VBA解释器/编译器,但是你没有带有行号或其他内容的详细错误消息?
答案 1 :(得分:0)
我认为它就在你的私人子cmdSearch_Click()
cboLocation.Clear
Sheets("Location").Select
Range("A2").Select
Do Until ActiveCell.Value = "" '-------> You dont have 'Loop'