-2

嗨，我有一个链接到我的 Excel 工作表的 VB，它是由以前的 IT 人员完成的。现在它显示错误“End If without Block If”。请帮我调试。下面的代码。谢谢你们。

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

任何帮助深表感谢。谢谢

4

2 回答 2

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 解释器/编译器关闭，但是您没有任何带有行号或其他任何详细错误消息吗？

于 2013-06-14T06:27:04.827 回答
0

我认为它在这里..在您的私人子 cmdSearch_Click()

    cboLocation.Clear
    Sheets("Location").Select
    Range("A2").Select

    Do Until ActiveCell.Value = "" '-------> You dont have 'Loop'
于 2013-06-14T07:29:52.830 回答