如何在一行中显示最多4个数据?

Question

添加到当前的VBA代码中，是否有一种方法可以显示一行中最多4个数据，而其他数据将落在下一行?

Option Explicit
Sub InvoiceDataGrouping()
Dim DataSet As Variant, Counter As Long, Dict As Object

'Set Dict = New Scripting.Dictionary 'Early Binding
Set Dict = CreateObject("Scripting.Dictionary") 'Late Binding

'stores in an array all the data from columns A and B,
'starting at A1 and up to the last row with data from column B.
DataSet = Sheets("DO").Range("A1", Range("B" & Rows.Count).End(3)).Value2

For Counter = 1 To UBound(DataSet)

Dict(DataSet(Counter, 1)) = Dict(DataSet(Counter, 1)) _
+ " " & DataSet(Counter, 2)
Next

Sheets("DO").Range("E1").Resize(Dict.Count, 2).Value = Application.Transpose(Array(Dict.keys, Dict.items))

Set Dict = Nothing
End Sub

Answer 1

使用Collection而不是字符串来保存发票号。然后循环遍历集合，创建一个最多包含4个发票的字符串。

更新1 -排序数据

Sub InvoiceDataGroupingBy4()
Dim DataSet As Variant, dict As Object, key
Dim lastrow As Long, i As Long, r As Long, n As Long
Dim s As String, rng As Range

'Set Dict = New Scripting.Dictionary 'Early Binding
Set dict = CreateObject("Scripting.Dictionary") 'Late Binding

'stores in an array all the data from columns A and B,
'starting at A1 and up to the last row with data from column B.
With Sheets("DO")
lastrow = .Range("B" & Rows.count).End(xlUp).Row
Set rng = .Range("A1:B" & lastrow)
' sort on col A and B
With .Sort
.SortFields.Clear
.SortFields.Add key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rng
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
DataSet = rng.Value2

For i = 1 To UBound(DataSet)
key = DataSet(i, 1) ' date
If Not dict.exists(key) Then
dict.Add key, New Collection
End If
dict(key).Add DataSet(i, 2) ' invoice no
Next

' reuse DataSet for grouping
For Each key In dict
n = dict(key).count ' number of invoices for date
For i = 1 To n
s = s & " " & dict(key)(i)
If (i Mod 4 = 0) Or (i = n) Then
r = r + 1
DataSet(r, 1) = Format(key, "DD.MM.YY")
DataSet(r, 2) = Trim(s)
s = ""
End If
Next
Next
' write re-used part of DataSet to sheet
Sheets("DO").Range("D1").Resize(r, 2) = DataSet
Set dict = Nothing
End Sub

Answer 2

这是一个相当混乱的函数:

Function group_array(data As Variant) As Variant
Dim i As Long, count As Byte, ref As String, group As String, id As Long

' store the first date and set the first group id
ref = data(1, 1)
id = 1

' change the first date to make it unique
data(1, 1) = data(1, 1) & ":1"

' make a counter to limit the items to four in a group
count = 0

' go through the data array, changing it to build the groups
For i = 2 To UBound(data)
count = count + 1  ' increment group count
If ref = data(i, 1) And count < 4 Then
ref = data(i, 1)
data(i, 1) = data(i, 1) & ":" & CStr(id)
Else ' a new group starts here
id = id + 1
count = 0
ref = data(i, 1)
data(i, 1) = data(i, 1) & ":" & CStr(id)
End If
Next
group_array = data
End Function

你可以在你的原始代码中像这样调用它:

' group the data using the function below
DataSet = group_array(DataSet)