excel - 如果找到，如何选择特定单元格并在另一个单元格中执行函数
问题描述
我希望能够检查（这是第一个 With 语句）是否在打开的工作表中（我将此工作表称为Sheet1，因为它在我的工作簿中是Sheet1 ）中的某个单元格值（本例中为“H4” ）正在编写代码（我想知道正在编写代码的工作表的正确命名方案是什么）存在于另一个工作表的单元格 A中（“HE 171”是工作表名称，我将其称为本例中为“HE171”）在不同的工作簿中（本例中为“Md”主数据库）；
然后如果它存在于主数据库中，我想检查（这是第二个 With 语句）该特定单元格的值（再次为"H4"）是否存在于更改数据库工作簿中（在此示例）在工作表“更改”中（在此示例中，工作表名为“更改”）
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
目前，当我第一次运行代码时，它会在两个外部工作表中为我创建一个新行（一个工作簿中的“更改”，另一个工作簿中的“HE171”），因为它在两个工作簿中都不存在，但它失败了将任何值（在 Sheet1（存在代码的工作表）中的“K”单元格中）复制到“更改”表中的相应单元格（模块 8 应该执行此操作，如下所示）；这是模块 8
'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
解决方案
推荐阅读
- javascript - ts 文件中的模块导出不是模块错误
- c++ - 调整对象不是小部件类型 GtkBuilder
- javascript - 在 css 中用 % 改变我的宽度，改变 bootstrap flex
- javascript - 消息提及和作者返回 TypeError：无法读取未定义 Discord.js 的属性“id”
- c++ - 碎片着色器和玩家移动的 glsl 奇怪行为
- javascript - 如何在单选按钮单击时在 React js 中映射数据？
- reactjs - 反应动画离开 div 内容
- python - 使用字典查找获得最高百分比的学生的姓名
- powershell - Powershell远程安装exe文件但它永远不会完成
- javascript - 我的第一个代码不起作用，但我的第二个代码起作用。第一个有什么问题？