Как я могу структурировать горизонтальные петли? - PullRequest
Новая
       9

Как я могу структурировать горизонтальные петли?

0 голосов
/ 29 июня 2018

До сих пор я добился больших успехов в разработке своего решения, но наткнулся на стену и хотел бы попросить совета. Мое требование состоит в том, чтобы создать отчет, который суммирует доход за неделю только за первые 13 недель для всех клиентов, которые начали с 2018-01-01 или позже. У меня есть простой msquery, который возвращает список клиентов и даты их начала (столбец A и B), затем я определяю детали дат начала и окончания первых 13 недель для каждого клиента в ряду (столбец C - AB) .

Я создал соединение ADODB и могу передать свой сложный SQL-запрос с параметрами даты начала и окончания (с планами добавления параметра для имени клиента), затем я застрял. Я не могу понять или обернуть голову, вызывая запрос для каждого клиента и каждого набора дат (столбец C / D, E / F, G / H и т. Д.), Чтобы сообщать о еженедельном доходе за каждую неделю, так как горизонтальный список. Моим конечным результатом должна быть одна рабочая таблица, содержащая имя каждого клиента в столбце A и его еженедельный доход за первые 13 недель обслуживания, распределенные по столбцам B - N.

Вот что у меня так далеко ... 

Option Explicit

Const ConStrSQL As String = "Provider=SQLNCLI11;Server=SQLSERVER;Database=MY_DB;Trusted_Connection=yes;"

Sub Refresh() 'Clear previous queries and results sets
Dim DataSh, ResultsSh As Worksheet

With Application
    .DisplayAlerts = False
    .EnableEvents = False
    .ScreenUpdating = False
End With

'Refresh the query sheets
For Each DataSh In Sheets(Array("DP-Customers"))
    DataSh.Select
    Rows.Hidden = False
        With ActiveSheet
            .Rows("2:" & .Rows.Count).Select
            Selection.ClearContents
        End With
    Range("A1").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Next

CalculateDates

End Sub

Sub CalculateDates()

Dim lRow As Long

lRow = LastRow(wsDPCustomers)

wsDPCustomers.Range("C2:C" & lRow).Formula = "=B2 -WEEKDAY(TODAY(),3)"
wsDPCustomers.Range("D2:D" & lRow).Formula = "=C2+6"
wsDPCustomers.Range("E2:E" & lRow).Formula = "=D2+1"
wsDPCustomers.Range("F2:F" & lRow).Formula = "=E2+6"
wsDPCustomers.Range("G2:G" & lRow).Formula = "=F2+1"
wsDPCustomers.Range("H2:H" & lRow).Formula = "=G2+6"
wsDPCustomers.Range("I2:I" & lRow).Formula = "=H2+1"
wsDPCustomers.Range("J2:J" & lRow).Formula = "=I2+6"
wsDPCustomers.Range("K2:K" & lRow).Formula = "=J2+1"
wsDPCustomers.Range("L2:L" & lRow).Formula = "=K2+6"
wsDPCustomers.Range("M2:M" & lRow).Formula = "=L2+1"
wsDPCustomers.Range("N2:N" & lRow).Formula = "=M2+6"
wsDPCustomers.Range("O2:O" & lRow).Formula = "=N2+1"
wsDPCustomers.Range("P2:P" & lRow).Formula = "=O2+6"
wsDPCustomers.Range("Q2:Q" & lRow).Formula = "=P2+1"
wsDPCustomers.Range("R2:R" & lRow).Formula = "=Q2+6"
wsDPCustomers.Range("S2:S" & lRow).Formula = "=R2+1"
wsDPCustomers.Range("T2:T" & lRow).Formula = "=S2+6"
wsDPCustomers.Range("U2:U" & lRow).Formula = "=T2+1"
wsDPCustomers.Range("V2:V" & lRow).Formula = "=U2+6"
wsDPCustomers.Range("W2:W" & lRow).Formula = "=V2+1"
wsDPCustomers.Range("X2:X" & lRow).Formula = "=W2+6"
wsDPCustomers.Range("Y2:Y" & lRow).Formula = "=X2+1"
wsDPCustomers.Range("Z2:Z" & lRow).Formula = "=Y2+6"
wsDPCustomers.Range("AA2:AA" & lRow).Formula = "=Z2+1"
wsDPCustomers.Range("AB2:AB" & lRow).Formula = "=AA2+6"

wsDPCustomers.Range("A1").CurrentRegion.EntireColumn.AutoFit
wsDPCustomers.Range("A1").Select

CopyDataFromDatabaseEarlyBinding
'CopyResults

End Sub

Sub CopyResults()
Dim dateRange As Range
Dim lineItem As Range

wsDPCustomers.Range("A1:B" & LastRow(wsDPCustomers)).Copy
wsCustomers.Range("A1").PasteSpecial xlPasteValues

Set dateRange = wsCustomers.Range("A1:A" & LastRow(wsCustomers))

wsCustomers.Range("C1").Value = "Start Week"

For Each lineItem In dateRange.Rows
    wsCustomers.Range("C" & dateRange).Formula = "=B"" & dateRange =TODAY()-WEEKDAY(TODAY(),2)"
Next lineItem

End Sub

Sub CopyDataFromDatabaseEarlyBinding()

Dim LMConn As ADODB.Connection
Dim LMData As ADODB.Recordset
Dim LMField As ADODB.Field

Set LMConn = New ADODB.Connection
Set LMData = New ADODB.Recordset

LMConn.ConnectionString = ConStrSQL
LMConn.Open

On Error GoTo CloseConnection

With LMData
    .ActiveConnection = LMConn
    .Source = GetSQLString
    .LockType = adLockReadOnly
    .CursorType = adOpenForwardOnly
    .Open
End With

On Error GoTo CloseRecordSet
Worksheets.Add

For Each LMField In LMData.Fields
    ActiveCell.Value = LMField.Name
    ActiveCell.Offset(0, 1).Select
Next LMField

Range("A1").Select
Range("A2").CopyFromRecordset LMData
Range("A1").CurrentRegion.EntireColumn.AutoFit

On Error GoTo 0

CloseRecordSet:
LMData.Close

CloseConnection:
LMConn.Close

End Sub
Sub CopyDataFromDatabaseLateBinding()

Dim LMConn As Object
Dim LMData As Object
Dim LMField As Object

Set LMConn = CreateObject("ADODB.Connection")
Set LMData = CreateObject("ADODB.Recordset")

LMConn.ConnectionString = ConStrSQL
LMConn.Open

On Error GoTo CloseConnection

With LMData
    .ActiveConnection = LMConn
    .Source = "SELECT LMCustomer.Name FROM LMCustomer" & _
    " & ""WHERE Nact = 0"
    '.Source = "dbo.LMCustomer"
    .LockType = 1
    .CursorType = 0
    .Open
End With

On Error GoTo CloseRecordSet

Worksheets.Add

For Each LMField In LMData.Fields
    ActiveCell.Value = LMField.Name
    ActiveCell.Offset(0, 1).Select
Next LMField

Range("A1").Select
Range("A2").CopyFromRecordset LMData
Range("A1").CurrentRegion.EntireColumn.AutoFit

On Error GoTo 0

CloseRecordSet:
LMData.Close

CloseConnection:
LMConn.Close

End Sub

Function LastRow(targetSheet As Worksheet, Optional targetCol As String = "A")

With targetSheet
    LastRow = .Cells(.Rows.Count, targetCol).End(xlUp).Row
End With

End Function

Function GetSQLString() As String

Dim startDate As String, endDate As String
Dim sqlString As String

startDate = "'2018-06-18'"
endDate = "'2018-06-24'"

sqlString = "SELECT LMCustomer.Name " & _
    ",Sum(LMDelivery.LDRYCENSCHRG+LMDelivery.LDRYWGHTCHRG+LMDelivery.LDRYPIECCHRG-LMDelivery.RETNWGHTCRED " & _
    "-LMDelivery.RETNPIECCRED-LMDelivery.VRNCCHRG+LMDelivery.LDRYDELVCHRG+LMDelivery.PRCHCHRG+LMDelivery.LDRYPCNTCHRG " & _
    "+LMDelivery.AUXPCHRG01+LMDelivery.AUXPCHRG02+LMDelivery.AUXPCHRG03+LMDelivery.AUXPCHRG04+LMDelivery.AUXPCHRG05+LMDelivery.AUXPCHRG06 " & _
    "+LMDelivery.AUXPCHRG07+LMDelivery.AUXPCHRG08+LMDelivery.AUXPCHRG09+LMDelivery.AUXPCHRG10+LMDelivery.AUXPCHRG11+LMDelivery.AUXPCHRG12 " & _
    "-LMDelivery.AUXPCRED01-LMDelivery.AUXPCRED02-LMDelivery.AUXPCRED03-LMDelivery.AUXPCRED04-LMDelivery.AUXPCRED05-LMDelivery.AUXPCRED06 " & _
    "-LMDelivery.AUXPCRED07-LMDelivery.AUXPCRED08-LMDelivery.AUXPCRED09-LMDelivery.AUXPCRED10-LMDelivery.AUXPCRED11-LMDelivery.AUXPCRED12 " & _
    "+LMDelivery.AUXMCHRG01+LMDelivery.AUXMCHRG02+LMDelivery.AUXMCHRG03+LMDelivery.AUXMCHRG04+LMDelivery.AUXMCHRG05+LMDelivery.AUXMCHRG06 " & _
    "+LMDelivery.AUXMCHRG07+LMDelivery.AUXMCHRG08-LMDelivery.AUXMCRED01-LMDelivery.AUXMCRED02-LMDelivery.AUXMCRED03-LMDelivery.AUXMCRED04 " & _
    "-LMDelivery.AUXMCRED05-LMDelivery.AUXMCRED06-LMDelivery.AUXMCRED07-LMDelivery.AUXMCRED08) AS Revenue " & _
    "FROM LMDelivery " & _
    "JOIN LMCustomer ON LMDelivery.ShipCustRcID = LMCustomer.RcID " & _
    "WHERE (LMDelivery.LdryDelvDate BETWEEN " & startDate & "  AND " & endDate & ") AND (LMDelivery.UsefCanc = 0) " & _
    "GROUP BY LMCustomer.RcID, LMCustomer.Name"

GetSQLString = sqlString
End Function

Ответы [ 2 ]

0 голосов
/ 02 июля 2018

Спасибо всем за помощь в получении ответа. Я никогда бы не узнал о таких функциях, как DATEPART ... вот мое решение, которое дает мне еженедельный доход каждого клиента. Я создал представление SQL и в Excel я сделаю все это красиво и красиво. 

    FROM dbo.LMDelivery INNER JOIN
    dbo.LMCustomer ON dbo.LMDelivery.ShipCustRcID = dbo.LMCustomer.RcID INNER JOIN
    dbo.LMContract ON dbo.LMDelivery.ContRcID = dbo.LMContract.RcID
    WHERE (dbo.LMDelivery.UsefCanc = 0) AND (dbo.LMContract.StrtDate >= '2018-01-01') AND (dbo.LMDelivery.LdryDelvDate >= '2018-01-01')
    GROUP BY dbo.LMCustomer.RcID, dbo.LMCustomer.Name, DATEPART(week, dbo.LMDelivery.LdryDelvDate)
0 голосов
/ 30 июня 2018

Cange значение startDate, endDate, как это. 

startDate = "2018-06-18"
endDate = "2018-06-24"

И исправить sql вот так

# 2018-06-18 # и # 2018-06-24 # 

"WHERE (LMDelivery.LdryDelvDate BETWEEN #" & startDate & "#  AND #" & endDate & "#) AND (LMDelivery.UsefCanc = 0) " & _
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...