道歉，但我是一个完整且完整的VBA菜鸟。微软的支持人员为我们的公司编写了一个分为两部分的脚本，每次运行它都需要更长的时间来运行。这样做的原因是因为表不断变长，脚本的每个部分都从一开始就运行，并在每一行上完成它直到它结束。基本上，它查看一行，对数据进行评估，然后在该行内的空单元格中输入值。
如果脚本的每个部分都有一个首先找到第一个空单元格然后开始进行分析的前导码，那将是多么好的。我希望这是有道理的。我在这里附上了剧本。任何帮助将不胜感激..
Public Function update_maintable() As Boolean
Dim sUsernames() As String
Dim i As Long
Dim cn As ADODB.Connection
Dim rs1 As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim flg As Boolean, flgDebug As Boolean
Dim sLastStatus As String
flg = False
ReDim sUsernames(1, 0)
Set cn = CurrentProject.Connection
Set rs1 = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
rs2.Open "SELECT * FROM Orders", cn, adOpenForwardOnly, adLockOptimistic
Do While Not rs2.EOF
For i = CLng(1) To UBound(sUsernames, 2)
Debug.Print sUsernames(0, i)
If rs2("first name") & rs2("last name") & rs2("billing state") = sUsernames(0, i) Then
flg = True
rs2("customer status") = "R"
End If
Next
If flg = False And rs2("username") <> "" Then
ReDim Preserve sUsernames(1, UBound(sUsernames, 2) + 1)
sUsernames(0, UBound(sUsernames, 2)) = rs2("first name") & rs2("last name") & rs2("billing state")
sUsernames(1, UBound(sUsernames, 2)) = rs2("order#")
rs2("customer status") = "N"
End If
flg = False
rs2.MoveNext
Loop
Debug.Print "Number of Rows in Array: " & UBound(sUsernames, 2) + 1
Debug.Print "Number of columns in Array: " & UBound(sUsernames, 1) + 1
Set cn = Nothing
UpdateIndividualOrders
MsgBox "Customer Status field has been updated", vbOKOnly + vbInformation, "Table Updated"
update_maintable = True
End Function
Public Function UpdateIndividualOrders() As Boolean
Dim cn As ADODB.Connection
Dim rs1 As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim sLastStatus As String
Set cn = CurrentProject.Connection
Set rs1 = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
rs1.Open "Select * from Orders where Orders.[Customer Status]<>"""" AND Orders.[Customer Status] Is Not Null", cn, adOpenForwardOnly, adLockOptimistic
Do While Not rs1.EOF
sLastStatus = rs1("customer status")
rs2.Open "UPDATE Orders SET Orders.[Customer Status] = """ & sLastStatus & """ WHERE Orders.[Order#]=" & CInt(rs1("Order#")) & ";", cn, adOpenForwardOnly, adLockOptimistic
rs1.MoveNext
Loop
UpdateIndividualOrders = True
End Function
Public Function update_maintable2() As Boolean
Dim sUsernames() As String
Dim i As Long
Dim cn As ADODB.Connection
Dim rs1 As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim flg As Boolean, flgDebug As Boolean
Dim sLastStatus As String
flg = False
ReDim sSKUs(1, 0)
Set cn = CurrentProject.Connection
Set rs1 = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
rs2.Open "SELECT * FROM Orders", cn, adOpenForwardOnly, adLockOptimistic
Do While Not rs2.EOF
For i = CLng(1) To UBound(sSKUs, 2)
Debug.Print sSKUs(0, i)
If rs2("first name") & rs2("last name") & rs2("billing state") & rs2("sku") = sSKUs(0, i) Then
flg = True
rs2("repeating purchase") = "Y"
End If
Next
If flg = False And rs2("username") <> "" Then
ReDim Preserve sSKUs(1, UBound(sSKUs, 2) + 1)
sSKUs(0, UBound(sSKUs, 2)) = rs2("first name") & rs2("last name") & rs2("billing state") & rs2("sku")
rs2("repeating purchase") = "N"
End If
flg = False
rs2.MoveNext
Loop
Debug.Print "Number of Rows in Array: " & UBound(sSKUs, 2) + 1
Debug.Print "Number of columns in Array: " & UBound(sSKUs, 1) + 1
Set cn = Nothing
UpdateIndividualOrders
MsgBox "Repeating Purchase field has been updated", vbOKOnly + vbInformation, "Table Updated"
update_maintable2 = True
End Function