求助！编译错误: 注释只能出现在 End Sub、End Function 或 End Property

[Wpsssssa]

Dim A As String, LastCell As Range, ThisCell As Range

 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

On Error Resume Next

  Dim R, C As Integer

  Cancel = True

  If Target.Cells(1) = "" Then Exit Sub

  R = Target.Row

  C = Target.Column

  If R = 1 Then

    Select Case C

    Case 1

      Call Initialize

    Case 2

      Call Show_Level

    Case 3

      Call Unite_Direction

      Target.Select

    Case 5

      If [KYB] Then

        Call Import_KYB

      End If

    Case 8

      Call Absolute_Balance

      Target.Select

    End Select

    Exit Sub

  End If

  Select Case C

  Case 1

    Call Select_Vouchers(Target)

  Case 2

    Application.ScreenUpdating = False

    If [B1] = "科目全称" Then Call Change_Full_Name

    With Me

      .AutoFilterMode = False

      While .Cells(R, 14) > 1

        R = R - 1

      Wend

      Me.Range("A1:O1").AutoFilter

      With Me.Cells(1)

        .AutoFilter Field:=13, Criteria1:=Me.Cells(R, 13) & "*"

      End With

    End With

    If Application.WorksheetFunction.CountIf(Sheet5.Range("A:A"), Target.Offset(0, -1).Value) > 0 Then

      With Sheet5

        .AutoFilterMode = False

        .Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=Target.Offset(0, -1).Value

        .Select

      End With

    End If

    Application.ScreenUpdating = True

  End Select

End Sub

 

Private Sub Import_KYB()

On Error Resume Next

  Dim WB As Workbook, SH As Worksheet, CC As Long, R As Range

  With Import

    With Application.FileDialog(msoFileDialogOpen)

      .AllowMultiSelect = False

      .FilterIndex = 3

      .Show

      If .SelectedItems.Count = 0 Then Exit Sub

      Me.AutoFilterMode = False

      Me.UsedRange.Offset(1, 0).EntireRow.Delete

      Set WB = Workbooks.Open(.SelectedItems(1), False, True)

    End With

    ThisWorkbook.Names("SFN").RefersTo = "=""" & WB.FullName & """"

    Set SH = WB.ActiveSheet

    CC = SH.UsedRange.Columns.Count

    RC = SH.UsedRange.Rows.Count

    ThisWorkbook.Activate

    .Visible = xlSheetVisible

    .Rows("3:14").ClearContents

    .Rows("3:14").Cells.UnMerge

    .Cells(1, 2) = "科目余额表"

    .Cells(1, 6).Value = 2

    .Cells(1, 9).Value = RC

    .Cells(3, 1).Value = "行　号"

    For i = 1 To 5

      .Cells(i + 3, 1) = i

      .Cells(i + 8, 1) = i + 5

      .Cells(i + 14, 1) = RC + i - 5

    Next i

    SH.Range(SH.Cells(1, 1), SH.Cells(10, CC)).Copy .Cells(4, 2)

    .Range(.Cells(14, 1), .Cells(14, CC + 1)).Value = "⋯⋯"

    SH.Range(SH.Cells(RC - 4, 1), SH.Cells(RC, CC)).Copy .Cells(15, 2)

    .Range("A4:A19").HorizontalAlignment = xlCenter

    .Range(.Cells(4, 2), .Cells(19, CC + 1)).Style = "Normal"

    For Each R In .Range(.Cells(4, 2), .Cells(4, CC + 1))

      With R.Offset(-1, 0)

        .Validation.Delete

        .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

          xlBetween, Formula1:="科目代码,科目名称,期初方向,期初数量,期初余额,期初借方," & _

        "期初贷方,本期借方,本期贷方,期末方向,期末数量,期末余额,期末借方,期末贷方"

        .Validation.ErrorMessage = "请从下拉列表中选择。"

        .Style = "表头"

      End With

      Select Case Trim(R)

      Case "科目代码", "科目编码", "科目编号", "科目代号"

        R.Offset(-1, 0) = "科目代码"

      Case "科目名称"

        R.Offset(-1, 0) = "科目名称"

      Case "期初方向"

        R.Offset(-1, 0) = "期初方向"

      Case "期初余额", "期初金额"

        R.Offset(-1, 0) = "期初余额"

      Case "期初借方余额", "期初借方", "期初借方金额"

        R.Offset(-1, 0) = "期初借方"

      Case "期初贷方余额", "期初贷方", "期初贷方金额"

        R.Offset(-1, 0) = "期初贷方"

      Case "本年借方累计", "本期发生借方", "累计借方金额", "本期借方金额", "本期借方累计", "借方累计"

        R.Offset(-1, 0) = "本期借方"

      Case "本年贷方累计", "本期发生贷方", "累计贷方金额", "本期贷方金额", "本期贷方累计", "贷方累计"

        R.Offset(-1, 0) = "本期贷方"

      Case "期末方向"

        R.Offset(-1, 0) = "期末方向"

      Case "期末余额", "期末金额"

        R.Offset(-1, 0) = "期末余额"

      Case "期末借方余额", "期末借方", "期末借方金额"

        R.Offset(-1, 0) = "期末借方"

      Case "期末贷方余额", "期末贷方", "期末贷方金额"

        R.Offset(-1, 0) = "期末贷方"

      Case "期初数量"

        R.Offset(-1, 0) = "期初数量"

      Case "期末数量"

        R.Offset(-1, 0) = "期末数量"

      Case "方向"

        If Application.WorksheetFunction.CountIf(.Range(.Cells(4, 1), R.Offset(0, -1)), "方向") = 0 Then

          R.Offset(-1, 0) = "期初方向"

        Else

          R.Offset(-1, 0) = "期末方向"

        End If

      Case Else

        R.Offset(-1, 0).Style = "输入"

      End Select

    Next R

    WB.Close False

    Application.Goto .Cells(1, 11)

  End With

End Sub

 

Private Sub Unite_Direction()

On Error Resume Next

  Dim RC As Long, FO() As Boolean, FC() As String, AFM As Boolean

  RC = Me.UsedRange.Rows.Count

  If RC < 2 Then Exit Sub

  Application.Calculation = xlCalculationManual

  For i = 2 To RC

    Select Case Left(Cells(i, 1), 1)

    Case 1, 3, 5

      Cells(i, 3) = IIf(Cells(i, 11) = 0, "平", "借")

      Cells(i, 5) = Cells(i, 11)

      Cells(i, 8) = IIf(Cells(i, 12) = 0, "平", "借")

      Cells(i, 10) = Cells(i, 12)

    Case 2, 4

      Cells(i, 3) = IIf(Cells(i, 11) = 0, "平", "贷")

      Cells(i, 5) = -Cells(i, 11)

      Cells(i, 8) = IIf(Cells(i, 12) = 0, "平", "贷")

      Cells(i, 10) = -Cells(i, 12)

    End Select

  Next i

  Application.Calculation = xlCalculationAutomatic

End Sub

 

Private Sub Absolute_Balance()

On Error Resume Next

  RC = Me.UsedRange.Rows.Count

  If RC < 3 Then Exit Sub

  Application.Calculation = xlCalculationManual

  For i = 3 To RC

    Cells(i, 3) = IIf(Cells(i, 11) = 0, "平", IIf(Cells(i, 11) > 0, "借", "贷"))

    Cells(i, 5) = Abs(Cells(i, 11))

    Cells(i, 8) = IIf(Cells(i, 12) = 0, "平", IIf(Cells(i, 12) > 0, "借", "贷"))

    Cells(i, 10) = Abs(Cells(i, 12))

    If Left(Cells(i, 1), 1) = 5 Then Exit For

  Next i

  Application.Calculation = xlCalculationAutomatic

End Sub

 

Private Sub Show_Level()

On Error Resume Next

  Dim R As Range, X As String, T As String

  On Error Resume Next

  X = vbCr: T = vbTab

  X = InputBox("输入功能代码（n∈[2,9]）：" & X & X & _

    "1" & T & "显示到全部科目" & X & _

    "n" & T & "显示到 1~n 级科目" & X & _

    "-n" & T & "只显示第 n 级科目" & X & _

    "0" & T & "切换科目全名\名称" & X & _

    "-" & T & "只显示明细科目" & _

    "")

  RC = Me.UsedRange.Rows.Count

  With Me.Range("A1:O1")

    Select Case X

    Case 1

      If Me.Range("B1") = "科目全称" Then

        Call Change_Full_Name

      End If

      .AutoFilter Field:=14

      .AutoFilter Field:=15

    Case 2 To 9

      .AutoFilter Field:=14, Criteria1:="<=" & X

      .AutoFilter Field:=15

    Case -2 To -9

      .AutoFilter Field:=14, Criteria1:="=" & Abs(X), Operator:=xlOr, Criteria2:="=1", VisibleDropDown:=True

      .AutoFilter Field:=15

    Case 0

      .AutoFilter Field:=15

      Call Change_Full_Name

    Case "-", "－", "—"

      If Me.AutoFilter.Filters(15).On Then

        If Me.AutoFilter.Filters(15).Criteria1 = "=1" Then

          .AutoFilter Field:=15

        Else

          .AutoFilter Field:=15, Criteria1:="=1"

        End If

      Else

        .AutoFilter Field:=15, Criteria1:="=1"

      End If

    Case Else

      Exit Sub

    End Select

  End With

End Sub

 

 

Private Sub Change_Full_Name()

On Error Resume Next

  Application.ScreenUpdating = False

  With Me

    .Range("B:B").Cut .Range("Z1")

    .Range("M:M").Cut .Range("B1")

    .Range("Z:Z").Cut .Range("M1")

    .Columns(2).ColumnWidth = 60

    .Columns(13).Hidden = True

  End With

  Application.CutCopyMode = False

  Application.ScreenUpdating = True

End Sub

 

 

Private Sub Select_Vouchers(Target As Range)

  With Sheet2

    .AutoFilterMode = False

    While Application.WorksheetFunction.CountIf(.Columns(1), Target.Text & "*") = 0

      Set Target = Target.Offset(-1, 0)

    Wend

    .Range("A1:K1").AutoFilter

    .Range("A1").AutoFilter Field:=1, Criteria1:="=" & Target.Value & "*"

    .Cells(1).AutoFilter Field:=3 ', VisibleDropDown:=False

    .Cells(1).AutoFilter Field:=4 ', VisibleDropDown:=False

    .Cells(1).AutoFilter Field:=11 ', VisibleDropDown:=False

    ThisWorkbook.Names.Add "Selected", "=" & Target.Address, False

    .Columns("H:H").Hidden = (.[H1] = 0)

    .Columns("I:J").Hidden = True

    Application.Goto .Cells(1, 1), True

    .Activate

  End With

  If Application.WorksheetFunction.CountIf(Sheet5.[A:A], Target) > 0 Then

    With Sheet5

      .Visible = xlSheetVisible

      .AutoFilterMode = False

      .Range("A1:M1").AutoFilter

      .Range("A1").AutoFilter Field:=1, Criteria1:=Target

      Application.Goto .[A1]

    End With

  End If

End Sub

 

 

On Error Resume Next

  If Not ThisCell Is Nothing Then Set ThisCell = Target.CE

  Set LastCell = ThisCell

  Set ThisCell = Target.Cells(1)

  If Target.Cells.Count > 1 Then Target.Copy Else Application.CutCopyMode = False

End Sub

 

Private Sub Initialize()

On Error Resume Next

  Application.ScreenUpdating = False

  Me.AutoFilterMode = False

  Me.Range("A1:O1").AutoFilter

  With Me.Cells(1, 1)

    .AutoFilter Field:=14, Criteria1:="1"

    For i = 1 To 11

      .AutoFilter Field:=i, VisibleDropDown:=False

    Next i

  End With

  For i = 1 To 14

    Me.Columns(i).ColumnWidth = Array(15, 60, 2, 0, 15, 15, 15, 2, 0, 15, 0, 0, 0, 0)(i - 1)

  Next i

  'Me.Columns("K:N").Hidden = True

  Application.ScreenUpdating = True

End Sub