如何构造水平循环？

时间：2018-06-29 18:42:08

标签： excel-vba vba excel

到目前为止，我在开发解决方案方面已经取得了长足的进步，但是我遇到了麻烦，想寻求一些建议。我的要求是为2018年1月1日或之后开始的任何客户构建一个报告，仅按头13周的每周收入汇总。我有一个简单的msquery，它返回客户列表及其开始日期（A和B列），然后针对该行中的每个客户计算出前13周的开始和结束日期的详细信息（列C-AB）

我创建了ADODB连接，并且可以通过带有开始日期和结束日期参数的复杂SQL查询（计划为客户名称添加参数），然后陷入困境。我无法弄清楚，也无法专心为每个客户和每个日期集（col 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 :(得分：0)

像这样设置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) " & _

答案 1 :(得分：0)

感谢大家帮助我顺利完成我的回答。我从未听说过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)
相关问题
最新问题