Question

我在Worksheets("Jobs")上有一个动态主表，它有固定数量的列（A：M）。列I和J是公式。

在另一个工作表上，我有一个将指定作业＃的文本框。我需要列L＆amp;列中的值。 M为匹配的作业＃更改为“No”。我之前的代码运行得太慢了。我正在尝试使用数组重写代码，但我很难这样做。

我们的想法是将整个表传输到基于内存的数组并对数组进行更改，然后将更新的表数据传输回工作表。

问题是如果我这样做，那就不会清楚那些有公式的内容。我可以在列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更新了以下代码（我仍在浏览屏幕）。当作业＃不匹配时，我收到运行时错误消息“找不到单元格”，调试行是：.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()方法轻松调整代码，但更容易（和逻辑）调整命名范围的大小并将它们包含在标题中

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

1 个答案: