gpt4 book ai didi

excel - VBA 代码返回 if 语句的编译错误

转载 作者:行者123 更新时间:2023-12-02 10:57:20 25 4
gpt4 key购买 nike

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

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

1) 如果运算符(operator)在 Commandbutton1 上点击"is",我希望代码检查 Sheet1 中单元格“H4”中的值是否存在于主数据库中“HE 171”表的 A 列中,然后,

2)如果“H4”中的值在主数据库中存在,我希望代码检查 Sheet1 中的单元格“H4”中的值是否存在于 CHANGES 数据库的“更改”表的 A 列中,如果“H4”的值在“更改”表中存在我希望代码使用模块 13(我尚未发布)在“更改”表的两列中设置日期和时间戳,并使用模块 8 发送从某些列“K”到“更改”表内的单元格的值(例如,我希望模块 8 过滤列 A 中的“H4”值并将其放在第 2 行中,因为第 1 行有我的标题,并将“K30”的值从 Sheet1 放置到“更改”表中的单元格 (1,6))

2.1)如果“H4”中的值在主数据库中存在,并且如果“H4”的值在“更改”表中不存在,我希望代码使用模块 14(尚未发布)添加将“H4”值放入 CHANGES 数据库中“CHANGES”表中新行的 A 列,模块 13(我尚未发布)在“CHANGES”表的两列中设置日期和时间戳,以及模块 8 将某些列“K”中的值发送到“更改”表内的单元格

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

5)如果运算符(operator)在 Commandbutton1 上点击“NO”或“x”,我希望代码使用密码保存并关闭两个外部工作簿(主数据库和更改数据库),然后保护 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

最佳答案

如果你去掉所有没有开始或结束语句 block 的东西,你会得到这个代码:

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
每次开始一个新 block 时,都可以考虑将新 block 添加到一堆 block 语句的顶部。每当您关闭一个 block 时,您都必须关闭当前位于堆栈顶部的 block 。如果不匹配(例如,堆栈顶部的 block 是 With block ,但您尝试使用 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: Else从 #6.1 替换 If来自#6
  • Else来自#6.1
  • With来自#5
  • If来自#4
  • With来自#3
  • If来自#2
  • Sub来自#1

  • 7: End If在 #7 匹配 Else在#6.1
  • With来自#5
  • If来自#4
  • With来自#3
  • If来自#2
  • Sub来自#1

  • 8:
    错误: Else #4.1 与 With 不匹配在堆栈顶部的#5。这个 Else实际上涉及到 If在#4

    关于excel - VBA 代码返回 if 语句的编译错误,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/58935885/

    25 4 0
    Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
    广告合作:1813099741@qq.com 6ren.com