Database 对齐行以匹配列

Database 对齐行以匹配列,database,vba,excel,Database,Vba,Excel,问题 如何水平对齐单独列中的值,并应用动态公式?先发制人谢谢你的任何帮助或线索!粘贴在下面的代码可以工作,只要它到达目的地的一半。但如何实现最后两个目标呢 每个范围加1 2水平对齐范围 包含客户id、商品和价格的样本表。左边是星期一的销售额,右边是星期二的销售额 当前结果 预期结果 将A行和E行上的cust id与关联的总和对齐。请注意,每条黄线如何包含用于标识的cust id以及相关的总和。 现有VBA代码 如果我需要这样的东西,我可能会再三考虑我想要什么以及为什么:如果最初的日期列表不是

问题

如何水平对齐单独列中的值,并应用动态公式?先发制人谢谢你的任何帮助或线索!粘贴在下面的代码可以工作,只要它到达目的地的一半。但如何实现最后两个目标呢

每个范围加1

2水平对齐范围

包含客户id、商品和价格的样本表。左边是星期一的销售额,右边是星期二的销售额

当前结果

预期结果

将A行和E行上的cust id与关联的总和对齐。请注意,每条黄线如何包含用于标识的cust id以及相关的总和。

现有VBA代码


如果我需要这样的东西,我可能会再三考虑我想要什么以及为什么:如果最初的日期列表不是从某个地方来的,你可以把所有的东西都放在一个列表中,然后做一些支点

但是。这里有一些想法,再次使用阵列,可能还有工作要做,但这是否有帮助:

Option Base 1

Sub ReLists()

Dim ListSheet As Worksheet
Dim DayCorners() As Range
Dim Day()
Dim Days As Integer
Dim CustIDs()
Dim CustomerRow()           'for placement in the final list
Dim DayList()
Dim MaxCustIDs As Integer
Dim NewCustID As Boolean

Days = 2
MaxCustIDs = 5

ReDim DayCorners(Days)
ReDim Day(Days)
ReDim CustomerRow(MaxCustIDs + 2)
CustomerRow(1) = 0

ReDim CustIDs(MaxCustIDs)
ReDim DayItems(1, 1)

Set ListSheet = Worksheets("Sheet1")
Set DayCorners(1) = ListSheet.Range("A2")
Set DayCorners(2) = ListSheet.Range("E2")

For d = 1 To Days

    With ListSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=DayCorners(d)
        .SetRange Range(DayCorners(d), DayCorners(d).End(xlDown).Offset(0, 2))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With

    Day(d) = Range(DayCorners(d), DayCorners(d).End(xlDown).Offset(0, 2))

    If UBound(Day(d), 1) > UBound(DayItems, 2) Then
        ReDim DayItems(Days, UBound(Day(d)))
    End If

Next d

CustIDCount = 0

For d = 1 To Days

    For r = 1 To UBound(Day(d), 1)

    NewCustID = True

        For u = 1 To UBound(CustIDs)
            If CustIDs(u) = Day(d)(r, 1) Then NewCustID = False
        Next u
        If NewCustID Then
            CustIDCount = CustIDCount + 1
            CustIDs(CustIDCount) = Day(d)(r, 1)

        End If
    Next r

Next d

    With Worksheets.Add(After:=Worksheets(ListSheet.Index))
        Set DayCorners(1) = .Range("A2")
        Set DayCorners(2) = .Range("E2")
    End With

ReDim DayList(Days, CustIDCount, 100, 3)

For d = 1 To Days

    For c = 1 To CustIDCount

    rc = 1

            For r = 1 To UBound(Day(d), 1)

                If Day(d)(r, 1) = CustIDs(c) Then

                    DayList(d, c, rc, 1) = Day(d)(r, 1)
                    DayList(d, c, rc, 2) = Day(d)(r, 2)
                    DayList(d, c, rc, 3) = Day(d)(r, 3)

                    rc = rc + 1

                End If

            Next r

        If CustomerRow(c) + rc + 2 > CustomerRow(c + 1) Then

            CustomerRow(c + 1) = CustomerRow(c) + rc + 1

        End If

    Next c

    If CustomerRow(c - 1) + rc + 2 > CustomerRow(c) Then

            CustomerRow(c) = CustomerRow(c) + rc

    End If

Next d

For d = 1 To Days

With DayCorners(d).Offset(-1, 0).Range("A1:C1")
    .Value = Array("cust id", "item", "Price")
    'formatting
End With

    For c = 1 To CustIDCount

    SumFormula = "=SUM(R[1]C:R[" & (CustomerRow(c + 1) - CustomerRow(c) - 1) & "]C)"

    With DayCorners(d).Offset(CustomerRow(c), 0).Range("A1:D1")
        If Not IsEmpty(DayList(d, c, 1, 1)) Then
            .Value = Array(CustIDs(c), "Sum", SumFormula, "")
        End If
        .Interior.Color = 65535
    End With

            For rc = 1 To UBound(Day(d), 1)

                If IsEmpty(DayList(d, c, rc, 1)) Then Exit For

                DayCorners(d).Offset(CustomerRow(c) + rc, 0) = DayList(d, c, rc, 1)
                DayCorners(d).Offset(CustomerRow(c) + rc, 1) = DayList(d, c, rc, 2)
                DayCorners(d).Offset(CustomerRow(c) + rc, 2) = DayList(d, c, rc, 3)

            Next rc

    Next c

Next d

End Sub

我相信解决方案是通过VBA模拟SQL完全外部联接。我会开始努力的。这应该是一个有趣的个人挑战。一旦找到最终解决方案,我将尝试更新此答案


我遵循的方向是。

您尝试过什么?你只是在寻找一个动态求和公式,将下面的值求和,直到第一个空行?当前的代码工作完美,但我只是做了简单的部分。最困难的部分是对齐行,以便所有“cust id”值在两个表之间以及该总和之间对齐。根据@BruceWayne的想法,我正在努力实现动态求和。
Option Base 1

Sub ReLists()

Dim ListSheet As Worksheet
Dim DayCorners() As Range
Dim Day()
Dim Days As Integer
Dim CustIDs()
Dim CustomerRow()           'for placement in the final list
Dim DayList()
Dim MaxCustIDs As Integer
Dim NewCustID As Boolean

Days = 2
MaxCustIDs = 5

ReDim DayCorners(Days)
ReDim Day(Days)
ReDim CustomerRow(MaxCustIDs + 2)
CustomerRow(1) = 0

ReDim CustIDs(MaxCustIDs)
ReDim DayItems(1, 1)

Set ListSheet = Worksheets("Sheet1")
Set DayCorners(1) = ListSheet.Range("A2")
Set DayCorners(2) = ListSheet.Range("E2")

For d = 1 To Days

    With ListSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=DayCorners(d)
        .SetRange Range(DayCorners(d), DayCorners(d).End(xlDown).Offset(0, 2))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With

    Day(d) = Range(DayCorners(d), DayCorners(d).End(xlDown).Offset(0, 2))

    If UBound(Day(d), 1) > UBound(DayItems, 2) Then
        ReDim DayItems(Days, UBound(Day(d)))
    End If

Next d

CustIDCount = 0

For d = 1 To Days

    For r = 1 To UBound(Day(d), 1)

    NewCustID = True

        For u = 1 To UBound(CustIDs)
            If CustIDs(u) = Day(d)(r, 1) Then NewCustID = False
        Next u
        If NewCustID Then
            CustIDCount = CustIDCount + 1
            CustIDs(CustIDCount) = Day(d)(r, 1)

        End If
    Next r

Next d

    With Worksheets.Add(After:=Worksheets(ListSheet.Index))
        Set DayCorners(1) = .Range("A2")
        Set DayCorners(2) = .Range("E2")
    End With

ReDim DayList(Days, CustIDCount, 100, 3)

For d = 1 To Days

    For c = 1 To CustIDCount

    rc = 1

            For r = 1 To UBound(Day(d), 1)

                If Day(d)(r, 1) = CustIDs(c) Then

                    DayList(d, c, rc, 1) = Day(d)(r, 1)
                    DayList(d, c, rc, 2) = Day(d)(r, 2)
                    DayList(d, c, rc, 3) = Day(d)(r, 3)

                    rc = rc + 1

                End If

            Next r

        If CustomerRow(c) + rc + 2 > CustomerRow(c + 1) Then

            CustomerRow(c + 1) = CustomerRow(c) + rc + 1

        End If

    Next c

    If CustomerRow(c - 1) + rc + 2 > CustomerRow(c) Then

            CustomerRow(c) = CustomerRow(c) + rc

    End If

Next d

For d = 1 To Days

With DayCorners(d).Offset(-1, 0).Range("A1:C1")
    .Value = Array("cust id", "item", "Price")
    'formatting
End With

    For c = 1 To CustIDCount

    SumFormula = "=SUM(R[1]C:R[" & (CustomerRow(c + 1) - CustomerRow(c) - 1) & "]C)"

    With DayCorners(d).Offset(CustomerRow(c), 0).Range("A1:D1")
        If Not IsEmpty(DayList(d, c, 1, 1)) Then
            .Value = Array(CustIDs(c), "Sum", SumFormula, "")
        End If
        .Interior.Color = 65535
    End With

            For rc = 1 To UBound(Day(d), 1)

                If IsEmpty(DayList(d, c, rc, 1)) Then Exit For

                DayCorners(d).Offset(CustomerRow(c) + rc, 0) = DayList(d, c, rc, 1)
                DayCorners(d).Offset(CustomerRow(c) + rc, 1) = DayList(d, c, rc, 2)
                DayCorners(d).Offset(CustomerRow(c) + rc, 2) = DayList(d, c, rc, 3)

            Next rc

    Next c

Next d

End Sub