VBA代码返回if语句

时间:2019-11-19 14:05:12

标签: excel vba if-statement compiler-errors

这是我在Sheet1上的代码的简要说明(我对VBA还是很陌生);

我有三本工作簿,一本工作簿(Sheet1是名为“ Operator”的工作表的代号,其中写入了VBA代码),另外两本外部工作簿具有不同的文件路径,称为“ Changes”(文件路径是:在我的代码中为Database_IRR 20-2S New.xlsm,这是CHANGES数据库)和“ HE171”(在我的代码中,文件路径为:Technology_Changes \ Changes_Database_IRR_20-2S_New.xlsm,这是MAIN数据库)。

1)如果操作员在Commandbutton1上单击“ YES”,我希望代码检查MAIN数据库的“ HE 171”表的A列中是否存在Sheet1的单元格“ H4”中的值,然后,< / p>

2)如果“ M4”数据库中的“ H4”中的值是当前值,我希望代码检查CHANGES数据库中“更改”表的A列中是否存在Sheet1的“ H4”单元格中的值并且如果“ CHANGES”表中的“ H4”值为PRESENT,则我希望代码使用模块13(我尚未发布)在“ CHANGES”表的两列中设置日期和时间戳, 8将特定“ K”列中的值发送到“ CHANGES”表内的单元格中(例如,我希望模块8过滤A列中的“ H4”的值,并将其与第1行一样放在第2行中我的标题,然后将Sheet1中“ K30”的值放入“ CHANGES”表中的单元格(1,6))

2.1)如果在MAIN数据库中“ H4”中的值是当前值,并且如果在“ CHANGES”表中不存在“ H4”的值,则我希望代码使用模块14(尚未发布)将“ H4”的值添加到CHANGES数据库第13单元的“ CHANGES”表中“ NEW”行的A列中(我尚未发布过),以在“ CHANGES”的两列中设置日期和时间戳表格和模块8,将值从某些“ K”列发送到“ CHANGES”表格内的单元格

3)如果MAIN数据库中不存在“ H4”中的值,我希望代码使用模块7(尚未发布)将“ H4”的值添加到其中的新行的列A中MAIN数据库,模块14中的“ HE 171”表(尚未发布),将“ H4”的值添加到“ CHANGES”表,模块13中的新行的A列中(我尚未发布) )在“ CHANGES”工作表的两列中设置日期和时间戳记,模块8将值从某些“ K”列发送到“ CHANGES”工作表内的单元格

5)如果操作员在Commandbutton1上单击“ NO”或“ x”,我希望代码使用密码保存并关闭两个外部工作簿(MAIN Databse和CHANGES数据库),然后保护Sheet1并保留它打开没有清除任何东西

    Option Explicit


    Dim Cd As Workbook
    Dim Md As Workbook

    Dim Changes As Worksheet
    Dim HE171 As Worksheet

    Dim nConfirmation As Integer

    'Actions for when the "Confirm Changes" button is clicked
    Private Sub CommandButton1_Click()


        Set Cd = Workbooks.Open("\FILEPATH/Technology_Changes\Changes_Database_IRR_20-2S_New.xlsm")
        Set Md = Workbooks.Open("\FILEPATH\Database_IRR 20-2S New.xlsm")


        Set Changes = Cd.Sheets("Changes")

        On Error Resume Next

        Set HE171 = Md.Sheets("HE 171")


        'Creating the "Yes or No" message box displayed when operators click the "Confirm Changes" button on the Operator Sheet
        nConfirmation = MsgBox("Do you want to send a notification about the sheet update?", vbInformation + vbYesNo, "Sheet Updates")

        'Declares the variable for the string that we will be finding, which is the key in this case (for the With statement)
        Dim FindString As String

        'Declares the variable for the range in which we will be locating the string (for the With statement)
        Dim RNG As Range

        'Sets the string we need to find as the key value which is in cell "H4" of the Operator sheet (for the With Statement)
        FindString = Sheet1.Range("H4").Value

        'Actions if "YES" is clicked when the "Confirm Changes" button is clicked on the Operator Sheet
        If nConfirmation = vbYes Then

            'Opens and activates the Main Database workbook, with "HE 171" as the active sheet
            HE171.Activate

            'Temporarily unprotects the Main Database Workbook and Operator sheet (this is the sheet the code is in)
            ActiveSheet.Unprotect "Swrf"
            Sheet1.Unprotect "Swrf"

            'Searches all of column A in the Main Database in sheet "HE 171" for the string(key)
            With ActiveSheet.Range("A:A")            'searches all of column A
                Set RNG = .Find(What:=FindString, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                'End With
                '////////////////////////////////////////////////////////////////////////////

                'Actions if the key is present in column A of the MAIN database
                If Not RNG Is Nothing Then

                    'Since Key is present in main database, now opens and sets the Changes_Database "Changes" Sheet as active contents
                    Changes.Activate

                    'Temporarily unprotects the Changes_Database
                    ActiveSheet.Unprotect "Swrf"

                    'Declares the variable for the string that we will be finding, which is the key in this case (for the With statement)
                    Dim FindString2 As String

                    'Declares the variable for the range in which we will be locating the string (for the With statement)
                    Dim RNG2 As Range

                    'Sets the string we need to find as the key value which is in cell "H4" of the Operator sheet (for the With Statement)
                    FindString2 = Sheet1.Range("H4").Value

                    'Searches all of column A in the Changes_Database "Changes" sheet for the string(key)
                    With ActiveSheet.Range("A:A")    'searches all of column A
                        Set RNG2 = .Find(What:=FindString, _
                                         After:=.Cells(.Cells.Count), _
                                         LookIn:=xlValues, _
                                         LookAt:=xlWhole, _
                                         SearchOrder:=xlByRows, _
                                         SearchDirection:=xlNext, _
                                         MatchCase:=False)


                        'Actions if the key is present in column A of the Changes_Database (So a change request was previously made for the key and it already has a row in the "Changes" sheet)
                        If Not RNG2 Is Nothing Then

                            'Calls module 13 to set the date and time of the requested change in the "Changes" sheet
                            Call TimeStamp

                            'Calls module 8 to send over the requested changes to the "Changes" sheet
                            Call SendChanges

                            'On Error Resume Next

                            'Protects the Changes_Database
                            ActiveSheet.Protect "Swrf"

                            '////////////////////////////////////////////////////////////////////////////

                            'Actions if the key DOES NOT exist in column A of the Changes_Database


                        Else

                            'Module 14: Adds a new row with the key to the Changes_Database
                            Call NewPart2

                            'Calls module 13 to set the date and time of the requested change in the "Changes" sheet
                            Call TimeStamp

                            'On Error Resume Next

                            'Calls module 8 to send over the requested changes to the "Changes" sheet
                            Call SendChanges

                        End If

                    End With

                Else

                    'Module 7:  Adds a new row with the key to the MAIN Database
                    Call NewPart

                    'Module 14: Adds a new row with the key to the Changes_Database
                    Call NewPart2

                    'Module 13: to set the date and time of the requested change in the "Changes" sheet
                    Call TimeStamp

                    'Module 10: Fills in the date and time the key was created for the "HE 171" sheet
                    Call TimeStamp2

                    'On Error Resume Next

                    'Calls module 8 to send over the requested changes to the "Changes" sheet
                    Call SendChanges

                End If

            End With


            'Actions if "No" is clicked when the "Confirm Changes" button is clicked on the Operator Sheet
        Else

            '''''''If nConfirmation = vbNo Then


            'Protects Changes_Database (as it was activated after the Main Database and is therefore the active contents and saves/closes it
            Changes.Activate
            ActiveSheet.Protect "Swrf"
            ActiveWorkbook.Save
            ActiveWorkbook.Close SaveChanges:=True

            'Sets Main Database as active contents to protect it, save it and close it
            HE171.Activate
            ActiveSheet.Protect "Swrf"
            ActiveWorkbook.Save
            ActiveWorkbook.Close SaveChanges:=True

            'Protects Operator Sheet and saves it
            Sheet1.Protect "Swrf"
            'Workbook.Close SaveChanges:=True

        End If

    End Sub

这是模块8 ,目前我的代码未粘贴我当前工作簿中k列中的值(这是VBA代码的写入位置,位于工作表中标题为“ Operator”的sheet1中)工作簿)。

    'Module 8: Sends the requested changes over to the "Changes" sheet

    Sub SendChanges()

        Set Cd = Workbooks.Open("\FILEPATH\Technology_Changes\Changes_Database_IRR_20-2S_New.xlsm")
        Set Changes = Cd.Sheets("Changes")

        Changes.Activate
        ActiveSheet.Unprotect "Swrf"

        '////////////////////////////////////////////////////////////////////////////'

        'Only executes this macro if the the new/change requested value in column "K" of the Operator sheet has a numerical value present
        If Sheet1.Range("K30").Value <> "" Then


            'Filters the Changes_Database for the part name & process (the key) which is in cell "H4" of the Operator sheet
            ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=Sheet1.Range("H4")


            'Copies the changed content in cell "K30" from the Operator Sheet
            Sheet1.Range("K30").Copy

            'Finds the row in the Changes_Database that has matched all filters and;
            'Pastes the value of cell "K30" into the matching parameter cell in the Changes_Database,which is in column 6 in this case
            ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 6).PasteSpecial xlPasteValues


            'Removes all filters and shows all data'
            ActiveSheet.ShowAllData


        End If
        '////////////////////////////////////////////////////////////////////////////'


        'Repeats the If and Else code bordered with slashes "////", for all parameter changes in the K column ("KXX")'
        If Sheet1.Range("K31").Value <> "" Then
            ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=Sheet1.Range("H4")
            Sheet1.Range("K31").Copy
            ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 7).PasteSpecial xlPasteValues

            ActiveSheet.ShowAllData
        End If


        If Sheet1.Range("K32").Value <> "" Then
            ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=Sheet1.Range("H4")
            Sheet1.Range("K32").Copy
            ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 8).PasteSpecial xlPasteValues

            ActiveSheet.ShowAllData
        End If

        'On Error Resume Next

        Sheet1.Range("K30:K115").ClearContents

        'On Error Resume Next

        ActiveSheet.Protect "Swrf"
        ActiveWorkbook.Save
        ActiveWorkbook.Close SaveChanges:=True

    End Sub

1 个答案:

答案 0 :(得分:0)

如果您剔除不是以语句块开头或结尾的所有内容,那么您将得到以下代码:

Private Sub CommandButton1_Click() '#1
    If nConfirmation = vbYes Then ' #2
        With ActiveSheet.Range("A:A") ' #3
            If Not RNG Is Nothing Then ' #4
                With ActiveSheet.Range("A:A") ' #5
                    If Not RNG Is Nothing Then ' #6
                    Else ' #6.1
                    End If ' #7
                ' ##### THERE SHOULD BE AN END WITH HERE ####
            Else ' #4.1
            End If ' #8
        End With ' #9
    Else ' #2.1
    End If ' #10
End Sub ' #11

每次启动新块时,您都可以考虑将新块添加到块语句堆栈的顶部。每当关闭一个块时,都必须关闭当前位于堆栈顶部的块。如果存在不匹配的情况(例如,堆栈顶部的块是With块,但您尝试使用End If将其关闭),则会发生错误

我已经在程序的每一行中添加了数字(Else语句略有变化)。这是执行每一行后,直到到达导致错误的行,该堆栈的外观:

1:

  • Sub 来自#1

2:

  • If 来自#2
  • Sub 来自#1

3:

  • With 来自#3
  • If 来自#2
  • Sub 来自#1

4:

  • If 来自#4
  • With 来自#3
  • If 来自#2
  • Sub 来自#1

5:

  • With 来自#5
  • If 来自#4
  • With 来自#3
  • If 来自#2
  • Sub 来自#1

6:

  • If 来自#6
  • With 来自#5
  • If 来自#4
  • With 来自#3
  • If 来自#2
  • Sub 来自#1

6.1:

#p中的

Else 替换了#6中的 If

  • Else 来自#6.1
  • With 来自#5
  • If 来自#4
  • With 来自#3
  • If 来自#2
  • Sub 来自#1

7:

The End If 在#7与 Else 在#6.1

  • With 来自#5
  • If 来自#4
  • With 来自#3
  • If 来自#2
  • Sub 来自#1

8:

错误:#4.1处的 Else 无法与#5顶部的 With 处的匹配。堆。这 Else 实际上与#4处的 If

有关