Home>

I want to input the value retrieved with SQL into Excel, but I don't know how to do it.
The data can be taken out.
If the previous row of the Excel cell is different from Wri (RowCnt, 0) fetched from SQL, enter it and then search for a column with the same value as Wri (RowCnt, 1) and Wri (RowCnt, 4) I want to input a value.
For i = 9 To UBound (Wri) will go, but it will not move forward with an error that an object is required after that.
Please teach me.

Public Function Output_202 (s () As String) As String
    Dim outputfile As String
    Dim sSQL As String
    Dim rst As ADODB.Recordset
    Dim sNen As String
    Dim sSin As String
    Dim sSgyo As String
    Dim sHday As String
    Dim Rec () As Variant
    Dim RowCnt As Long
    Dim ColCnt As Long
    Dim Wri () As Variant
    Dim wbk As Workbook
    Dim wks As Worksheet
    Dim i As Long
    Dim j As Long
    Dim c As Long
    'Set of arguments
    sNen = Mid $(s (1), 7, 2) 'FY
    sSin = Mid $(s (1), 6, 1) 'New/Resending
    sSgyo = Mid $(s (1), 12, 4) 'working date
    sHday = s (2) 'Ship Date
    'Prepare output file
    outputfile = sNen&"year"
    If sSin = "2" Then outputfile = outputfile&"_resend"
    outputfile = outputfile&"_Number table-Number of dispatches by course/vault_"
    outputfile = outputfile&Format $(Date $, "yyyymmdd")&Format $(Time $, "hhmmss")&".xlsx"
    If file_copy ("Z202.xlsx", sFolderFormatFile, outputfile, sFolderSaveFile) = 9 Then
        'File copy error
        Output_202 = "Cannot get template file Z202.xlsx"
        Exit Function
    End If
    Application.ScreenUpdating = False
    Set wbk = Workbooks.Open (sFolderSaveFile&outputfile)
    Application.ScreenUpdating = True
    'Read data
'On Error GoTo ERR_RTN:
    'Get data from DB
    If access_mySQL_Server = False Then
        GoTo ERR_RTN
    End If
    With cmd
        sSQL = "SELECT concat (wfz_bkcode, ':', wfz_bkname), concat (wfz_kzcode, cast (wfz_h_flg as char)) as code, wfz_count, wfz_test, count (wfz_bkcode)"
        sSQL = sSQL&"from"&s (1)&", kzz"
        sSQL = sSQL&"where wfz_kzcode = kzz_kzcode"
        sSQL = sSQL&"group by wfz_bkcode, code"
        .ActiveConnection = cnn
        .CommandText = sSQL
        Set rst = .Execute
        sSQL = ""
        ColCnt = rst.Fields.Count
        RowCnt = rst.RecordCount
        If RowCnt>0 Then
            ReDim Rec (ColCnt-1, RowCnt-1)
            Rec = rst.GetRows
        End If
        ReDim Wri (RowCnt, ColCnt)
        Set wks = wbk.Worksheets (1)
        For RowCnt = 0 To UBound (Rec, 2)
            Wri (RowCnt, 0) = CStr (Rec (0, RowCnt))
            Wri (RowCnt, 1) = CStr (Rec (1, RowCnt))
            If Len (Wri (RowCnt, 2)) = 1 Then
                Wri (RowCnt, 2) = "No."&StrConv (Wri (RowCnt, 2), vbWide)&"Volume"
            ElseIf Len (Wri (RowCnt, 2)) = 2 Then
                Wri (RowCnt, 2) = StrConv (Mid $(Wri (RowCnt, 2), 1, 1), vbWide)&"/"&StrConv (Mid $(Wri (RowCnt, 2), 2, 1), vbWide)&"Volume"
            End If
            If Wri (RowCnt, 3)<>"" Then
                Wri (RowCnt, 3) = "issue"&CStr (Rec (3, RowCnt))&"times"
            Else
                Wri (RowCnt, 3) = "×"
            End If
            Wri (RowCnt, 4) = Rec (4, RowCnt)
        Next
        For i = 9 To UBound (Wri)
            If wks.Cells (i-1, 2) .Value<>Wri (RowCnt, 0) .Value Then wks.Cells (i, 2) .Value = Wri (RowCnt, 0)
            For c = 4 To 38
                If wks.Cells (5, c) = Wri (RowCnt, 1) Then
                    j = wks.Cells (5, c) .colomn
                    Exit For
                End If
            Next
            wks.Cells (i, j) .Value = Wri (RowCnt, 4) .Value
        Next
        wks.Cells (1, 4) .Value = Format $(Date $, "yyyy/m/d")
        wks.Cells (3, 3) .Value = "20"&Format $(sSgyo, "## Year # Month")
        wks.Select
        wks.Cells (1, 1) .Select
    End With
    If close_mySQL_Server = False Then
        GoTo ERR_RTN
    End If
    Application.DisplayAlerts = False
    wbk.Save
    Application.DisplayAlerts = True
    wbk.Close
    Set wks = Nothing
    Set wbk = Nothing
    Output_202 = outputfile
Exit Function
ERR_RTN:
    If Len (sErr (0)) = 0 Then
        sErr (0) = CStr (Err.Number)
        sErr (1) = Err.Description
        sErr (2) = "Output_202"
        sErr (3) = sSQL
    End If
End Function
vba
  • Answer # 1

      

    For i = 9 To UBound (Wri) will go, but you can't move forward with an error that an object is needed after that.

    Wri ()is declared as Variant, but the assigned value is String?
    Let's delete.Value.

    If wks.Cells (i-1, 2) .Value<>Wri (RowCnt, 1) .Value Then wks.Cells (i, 2) .Value = Wri ( RowCnt, 1)

    This ↓ also wks.Cells (i, j) .Value = Wri (RowCnt, 4) .Value