使用数组根据条件更新表格单元格

我有一个Worksheets("Jobs")具有固定的列数（A：M）的dynamic主表。 列I和J是公式。

在不同的工作表上，我有一个文本框，将有一个指定的作业。 我需要在列L＆M中的值更改为“否”作为匹配的作业＃。 我之前的代码工作太慢了。 我试图用数组重写代码，但我很难这样做。

这个想法是将整个表转移到一个基于内存的数组，然后对数组进行更改，然后将更新后的表数据传回工作表。

问题是如果我这样做，是不是会清楚有公式的内容。 我可以使用两个基于列B的名称范围的数组，然后另一个列L：M？ 在这个数组中工作，只需要更新和传输只需要改变的值即可。 谢谢任何人可以提供的帮助。

这是我的代码到目前为止：

 Sub CloseJobarr() Dim cell As Range Dim Txt As String Dim ws As Worksheet Dim Arr1 As Variant, Arr2 As Variant Arr1 = Range("JobCol_Master").Value '<--Column B of Master Data Table that is on ws Arr2 = Range("OpenSCCols").Value '<--Columns L:M of Master Data Table that is on ws Set ws = ThisWorkbook.Worksheets("Jobs") With ThisWorkbook Txt = .Worksheets("ID").TextBoxID.Text If Txt <> "" Then With ws For Each cell In Arr1 'If job# matches textbox and if job# is to correct region then... If cell.Text = Txt And .Cells(cell.row, 4).Value = "ID" Then End If Next cell End With End If End With MsgBox "Job not found." End Sub 

更新下面的代码使用Auto Filter （我仍然遇到屏幕轻弹）。 当一个作业＃不匹配我得到一个运行时错误消息“找不到单元格”和debugging线是： .Range("OpenSCCols").SpecialCells(xlCellTypeVisible).Value = "No"

 Option Explicit Sub CloseJobarraytesting() ThisWorkbook.Sheets("Jobs").Unprotect Password:="Andersen" Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False On Error GoTo errHndl Dim cell As Range Dim Txt As String Dim ws As Worksheet With ThisWorkbook.Worksheets("Jobs") '<--| reference relevant worksheet .Range("JobCol_Master").AutoFilter Field:=2, Criteria1:=Worksheets("ID").TextBoxID.Text '<--| filter its "JobCol_Master" named range on textbox ID If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell filtered other than header .Range("OpenSCCols").SpecialCells(xlCellTypeVisible).Value = "No" '<-- write "OpenSCCols" named range filter cells, corresponding to the filtered ID Else MsgBox "Job not found." End If .AutoFilterMode = False End With CleanUp: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ThisWorkbook.Sheets("Jobs").Protect Password:="Andersen" Exit Sub errHndl: MsgBox "Error happened while working on: " + vbCrLf + _ vbCrLf + vbCrLf + "Error " + _ Str(Err.Number) + ": " + Err.Description, vbCritical + vbOKOnly, "Error" GoTo CleanUp End Sub 

Answer 1

编辑以使代码检查Range("JobCol_Master")上过滤的单元格

你的目标是实际的过滤数据，那么我相信一个AutoFilter()方法应该相当快

假设你定义了包含相应标题单元格的JobCol_Master和OpenSCCols命名范围，你可以简单地去

 Option Explicit Sub CloseJobarr() With ThisWorkbook.Worksheets("Jobs") '<--| reference relevant worksheet With .Range("JobCol_Master") .AutoFilter Field:=1, Criteria1:=Worksheets("ID").TextBoxID.Text '<--| filter its "JobCol_Master" named range on textbox ID If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell filtered other than header .Parent.Range("OpenSCCols").SpecialCells(xlCellTypeVisible).Value = "No" '<-- write "OpenSCCols" named range filter cells, corresponding to the filtered ID Else MsgBox "Job not found." End If End With .AutoFilterMode = False End With End Sub 

如果你的命名范围不包含它们的头文件，那么通过对它们应用一些Offset()和Resize()方法可以很容易地调整代码，但是更容易（和逻辑）调整命名范围的大小并且使它们包含它们的头文件