宏太慢了,这是一个正常的优秀情况吗?

时间:2013-09-02 14:26:04

标签: excel vba

有人可以告诉我,为什么这需要永远:(我需要循环一两年。我只是从单元格中执行查询并执行并写回来,更不用说它去了(没有响应)并使所有其他excel工作簿滞后。感谢任何建议

Function getsqldata2(ByVal Query As String) As ADODB.Recordset

    Dim conn As New ADODB.Connection
    Dim server_name As String
    Dim database_name As String
    Dim user_id As String
    Dim password As String
    Dim rs As ADODB.Recordset

    '----------------------------------------------------------------------
    'Establish connection to the database
    server_name = "AES-APP11"
    database_name = "v_mrf_4_Gen"
    user_id = "guest"    ' enter your user ID here
    password = "dcmguest"    ' Enter your password here
    Set conn = New ADODB.Connection
    conn.Open 'blablabla
    '----------------------------------------------------------------------
    On Error Resume Next
    Set rs = conn.Execute(Query)
    Set getsqldata2 = rs

End Function

Public Function findColumnNumber(ByVal strSearch As String) As Long
    Dim aCell As Range
    On Error Resume Next
    Set aCell = ThisWorkbook.Worksheets(" Status").Rows(4).Find(What:=strSearch, LookIn:=xlValues, _
                                                                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                                                MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
        findColumnNumber = aCell.Column
    End If

End Function
Public Function IsoWeekNumber(InDate As Date) As Long
    IsoWeekNumber = DatePart("ww", InDate, vbMonday, vbFirstFourDays)
End Function

Sub PDweekly()

    Dim I As Integer, j As Integer, n As Integer, m As Integer
    Dim Values(100, 10) As Integer
    Dim CountryCodes(100) As String
    Dim Data1(20) As String
    Dim EnvironmentMetaData(2 To 3) As String
    Dim t1, t2 As Double
    Dim Berk As String
    Dim NotrecordingTime As String
    Dim WeekNumber As Long
    Dim CurrentYear As Long
    Dim colName As String
    Dim colNumber As Long
    Dim WS_Count As Integer
    Dim ws As Integer
    Dim week As String
    Dim weekd As Integer
    Dim x As Date
    Dim yymmdd As Date
    Dim result As Object
    '---------------------------------------------------------

    currentdate = "2013-01-03"
    For weekd = 1 To 52
        yymmdd = currentdate

        WeekNumber = IsoWeekNumber(yymmdd)
        CurrentYear = Year(Date)
        If (WeekNumber < 10) Then
            colName = "w" + Right(CStr(CurrentYear), Len(CStr(CurrentYear)) - 2) + "0" + CStr(WeekNumber)
        Else
            colName = "w" + Right(CStr(CurrentYear), Len(CStr(CurrentYear)) - 2) + CStr(WeekNumber)
        End If

        colNumber = findColumnNumber(colName)
        If (Not colName = "w1353") Then


            For I = 8 To 89

                sqlstring = ThisWorkbook.Worksheets(" Status").Cells(5, 3).Value
                cc = ThisWorkbook.Worksheets(" Status").Cells(I, 2).Value
                sqlstring = Replace(sqlstring, "Code", cc)
                sqlstring = Replace(sqlstring, "TODATE", CStr(yymmdd))

                Set result = getsqldata2(sqlstring)
                If (IsNull(result)) Then
                    ThisWorkbook.Worksheets(" Status").Cells(I, colNumber) = result.Fields(0).Value = 0

                End If
                ThisWorkbook.Worksheets(" Status").Cells(I, colNumber) = result.Fields(0).Value
            Next I


            t2 = Timer
        End If
        currentdate = DateAdd("ww", 1, currentdate)
    Next weekd

End Sub

1 个答案:

答案 0 :(得分:0)

SQL最有可能放慢速度。你可以做的事情。

  • 打开功能外部的连接,直到之后才关闭它 你完成了。
  • 如果您在Code上没有索引,请创建一个索引。

如果你真的认为它是Excel。

  • 关闭Application.ScreenUpdating
  • 不是一次更新一次单元格,而是将整个网格作为数组检索并循环/更新数组 完成后将其粘贴回来。