Question

我有一个宏脚本，我已经构建它来从数据库中获取一个条目并将结果写入工作表，然后由工作簿中的其他宏处理。

为了重构我的代码，我在前端部分进行跳汰和制作按钮以使其更加光滑等等，这不是重要的部分。

以下是仍可使用的原始代码，

Sub Test()
Dim xm, dd As Worksheet
    Set dd = ThisWorkbook.Worksheets("Start Sheet")
    procName = dd.Cells(1, 1).Value
    If procName = "" Then
        MsgBox "There is no value in selected row." & Chr(10) & "Please go to 'Start Sheet' and select a value first.", vbExclamation, "Try again"
        Exit Sub
    End If

    Set xm = ThisWorkbook.Worksheets("The Work Page")
    xm.Cells.Clear

    Dim Cn As ADODB.Connection
    Dim Server_Name As String
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim SQLStr As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim objectName As String
    Dim objectTableCol As Collection
    Set objectTableCol = New Collection
    Dim y As Long
    Dim ExistsFlag As Boolean
    ExistsFlag = False


    Server_Name = "" ' Enter your server name here
    Database_Name = "" ' Enter your database name here
    User_ID = "" ' enter your user ID here
    Password = "" ' Enter your password here
    SQLStr = "SELECT columnname FROM [table name] WHERE name = 'some name of a column'"

    Set Cn = New ADODB.Connection
    Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
    ";Uid=" & User_ID & ";Pwd=" & Password & ";"

    rs.Open SQLStr, Cn, adOpenStatic

    'Chr(10) is a NewLine character
    bigarray = Split(rs.Fields("field name to split on"), Chr(10))

    rs.Close
    Set rs = Nothing
    Cn.Close
    Set Cn = Nothing

'********************************************************* Find Objects!! *******************************************************************************
For i = 0 To UBound(bigarray)
    xm.Cells(i + 1, 1).Value = bigarray(i)   'this bit of code writes code to the excel sheet. 
Next i

End Sub

这段代码被各种宏调用为子例程，并且在首页上通过按钮显示。它在运行中没有困难，平均运行时间约为5-6.5秒。

以下是我从上面的测试模块复制到工作簿中另一个单独模块的代码片段，用于代码重构。

Sub PopulateExcelWithXML()
Dim xm, dd As Worksheet
    Set dd = ThisWorkbook.Worksheets("Start Sheet")
    procName = dd.Cells(1, 1).Value
    If procName = "" Then
        MsgBox "There is no value in selected row." & Chr(10) & "Please go to 'Start Sheet' and select a process first.", vbExclamation, "Try again"
        Exit Sub
    End If

    Set xm = ThisWorkbook.Worksheets("The Work Page")
    xm.Cells.Clear

    Dim Cn As ADODB.Connection
    Dim Server_Name As String
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim SQLStr As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset

    Server_Name = "" ' Enter your server name here
    Database_Name = "" ' Enter your database name here
    User_ID = "" ' enter your user ID here
    Password = "s" ' Enter your password here
    SQLStr = "SELECT column name FROM [table name] WHERE name = 'name of some column'" 

    Set Cn = New ADODB.Connection
    Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
    ";Uid=" & User_ID & ";Pwd=" & Password & ";"

    rs.Open SQLStr, Cn, adOpenStatic

    'Chr(10) is a NewLine character
    bigarray = Split(rs.Fields("processxml"), Chr(10))

    rs.Close
    Set rs = Nothing
    Cn.Close
    Set Cn = Nothing

'********************************************************* Find Objects!! *******************************************************************************
For i = 0 To UBound(bigarray)
    xm.Cells(i + 1, 1).Value = bigarray(i) 'this bit of code writes code to the excel sheet. used for debugging
Next i

End Sub

现在，通过我右键单击并将宏指定给它的图像从首页调用此代码。在每个方面都非常简单和相似，减去他们写入的页面，一个是测试调试页面，一个是工作页面。然而，第二个宏的运行时间是20-25分钟。它非常缓慢，我不明白为什么。

可能有助于人们解决问题的其他信息。图像在另一台人机上工作正常，整个事情都包含在一个工作簿中，测试方法从未停止工作，新片只是它的c + v版本。我没有重新使用子命名测试，因为它坐在一个充满测试元素的测试页面中，我想保持这种方式，而是我制作另一个子并复制它，所以我可以根据需要调整新的丢失旧工作进行测试和调试。我在xp上运行并且在win 7上进行了测试，excel是2010.我仍然在这里撞墙，以找出造成它的原因。我从数据库中撤回的数据是来自一行的单个单元格，其中是一个完整的XML，可以是6000行到25000行的任意长度，因此从记录集拆分到数组以打印出来。

我没有找到只是使用测试方法的解决方案，我想知道为什么另一种方法没有正常工作以加深我对系统的理解。任何帮助赞赏。

删除了敏感字段，实际填充它们只是不留下详细信息

Answer 1

如果相同的代码在两台不同的机器上的工作方式不同，我怀疑代码没问题。也许您可以围绕For循环添加以下内容？

Application.Calculation = xlManual

Application.Calculation = xlAutomatic

宏在一个脚本中正常运行，但复制版本需要花费100倍

1 个答案: