S*******0
发帖数: 208 | 1 Can someone help me with the code, simply put is : find a cell in excel, and
copy the sql reusult dataset starting from the cell found, my code is as
follows, it did not indicate any error, but could not run, please help me to
identify where the problems, many thanks
Sub reshnepoolmonthValues()
Worksheets(2).Activate
Dim valuedt As String
Dim sql1 As String
Dim sql2 As String
Dim sql3 As String
Dim wrk As Worksheet
Dim inRng1 As Long
Dim inrng2 As Long
Dim outRng As Range
Dim cntr As Long
Dim outCntr As Long
Dim findVal1 As String
Dim findval2 As String
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set wrk = Worksheets("Positions")
inRng1 = Cells(8, Columns.Count).End(xlToLeft).Column
inrng2 = Cells(4, Columns.Count).End(xlToLeft).Column
Set outRng = wrk.Range("17:17")
conn.Open "ODBC;DATABASE=reports;DESCRIPTION=TCPM;DSN=TCPM;OPTION=0;PORT
=3306;SERVER=eppas_prod.tcpl.ca;UID=TCPM"
'put variables in the active cells
valuedt = FormateDte(ActiveSheet.Cells(1, 1).Value)
' Main SQL Statement
sql1 = "" & _
" SELECT VALUE FROM reports.ecreport WHERE valuedate='" & valuedt &
"' "
sql2 = "" & _
" AND reporttype='positions' AND zone= 'NEPOOL POWER (GWh)' AND TYPE
LIKE '%current%' AND MONTH IS NOT NULL AND YEAR IS NOT NULL "
sql3 = "" & _
" ORDER BY YEAR,STR_TO_DATE(MONTH, '%b'); "
Set rs = conn.Execute(sql1 & sql2 & sql3)
' Clear the output range
outRng.ClearContents
If rs.EOF Then
MsgBox ("data missing")
Else
'Copy the recordset values in cells
findVal1 = Year(Range("A1"))
findval2 = MonthName((month(Range("A1")) + 1), 3)
' Iterate through the rows in the input range. find the result then
write it to the output range
For cntr = 1 To inRng1
If Cells(8, cntr).Value = "findVal1" Then
If Cells(4, cntr).Value = "findval2" Then
ourcntr = cntr
While Not rs.EOF
Cells(17, outCntr).Value = rs.Fields(0).Value
outCntr = outCntr + 1
rs.MoveNext
Wend
Exit For
End If
End If
Next cntr
'expand the column to fit the data
Selection.EntireColumn.AutoFit
End If
End Sub |
|
