Question

我写了一些VBA代码，对数据表中输入的数据进行自定义检查。目前，我正在使用Workbook_BeforeSave事件从验证表中获取所有验证数据，并对输入到数据表中的数据执行验证。基于验证错误，我在数据表单元格中添加了注释。问题在于，它对于数据表中的数百条记录都可以正常工作，但是当涉及到数千条记录时，则需要花费几分钟。问题是要对可能接近5万条记录或更多记录的数据进行处理。 excel VBA脚本是否提供对多线程的支持？还是有其他方法可以做到这一点？

我已经在VBA中搜索了多线程，但答案是否定的，在某些帖子中它显示了可能，但它们不能同时在活动工作表上工作。

请提出建议。

*也可能从数据表中的其他工作表中复制数据。

在点击保存按钮之前，我会进行验证：

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     Dim WS_Count As Integer
     Dim i As Integer
     WS_Count = ActiveWorkbook.Worksheets.Count
     ' Begin the loop.
     For i = 1 To WS_Count

        ' Insert your code here.
        ' The following line shows how to reference a sheet within
        ' the loop by displaying the worksheet name in a dialog box.
        If Not ActiveWorkbook.Worksheets(i).Name = "Validation Data" Then
            CheckForCellValidation ActiveWorkbook.Worksheets(i).Name
        End If
     Next i
 End Sub

以下是我对工作表中范围的验证检查方法，它找到目标范围，并根据列ID进行验证：

Function CheckForCellValidation(ByVal sheetName As String)
Dim rng As Range
Dim sheetRng As Range
Dim varRng As Range
Dim lastCol As Long
Dim colName As String
Dim valOption As Long
Dim param
Dim errMsges
Dim Larr
Dim errMsg As String

Set rng = {Get all entries in validation sheet}

For Each cell In rng.Cells
    Set varRng = cell.Offset(1, 0)
    param = Split(varRng.Offset(1, 0).Value2, ":;") 'parameter in validation sheet, see attached image(multiple validations can be present for one column)
errMsges = Split(varRng.Offset(2, 0).Value2, ":;") 'error message, see attached image
Larr = Split(varRng.Value2, ":;")

Set sheetRange = Sheets(sheetName).Cells.Find(what:=cell.Value2, LookIn:=xlFormulas, LookAt _
    :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False)

If Not sheetRange Is Nothing Then
    colName = Replace(sheetRange(1).Address(0, 0), sheetRange(1).row, "")
    strVal = Sheets(sheetName).UsedRange.Rows.Count
    'Data entry starts from 7th row in data sheet
    Set sheetRange = Sheets(sheetName).Range(colName & CStr(7) & ":" & colName & strVal)
    sheetRange.Cells.Interior.ColorIndex = xlNone
    sheetRange.Cells.ClearComments

    For i = 0 To UBound(Larr)
        valOption = Larr(i)

        If UBound(errMsges) >= i Then
          errMsg = errMsges(i)
        Else
          errMsg = ""
        End If

    Select Case valOption
    Case Is = 1
        For Each cel In sheetRange.Cells
        ValidateMandatoryField cel, errMsg
        Next cel       

    Case Is = 6
    For Each cel In sheetRange.Cells
        ValidateRegEx cel, param(i), errMsg
    Next cel

    Case Is = 8
    For Each cel In sheetRange.Cells
    ValidateMinTextLength cel, param(i), errMsg
    Next cel

    Case Is = 9
    For Each cel In sheetRange.Cells
        ValidateNumericalLength cel, param(i), errMsg
    Next cel
    End Select
  Next i
  End If
Next cell
End Function

随附的验证表中的样本数据：

Answer 1

Excel和VBA绝对不是多线程技术。

您可以使用Windows Task Scheduler打开Workbook，fire和Open_Workbook事件，并在离开办公室后的某个时间运行脚本（例如，每天晚上在午夜运行Take，保存所有更改，结果将等待早上上班时给你）。

https://www.sevenforums.com/tutorials/11949-elevated-program-shortcut-without-uac-prompt-create.html

在Excel VBA中处理大量数据

1 个答案: