誰か教えてください、なぜこれは永遠にかかるのですか:(私は1年か2年くらいループする必要があります.私は単にセルからクエリを取得し、実行して書き戻しているだけです.他のすべての 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