需要幫助資料以進行發票資料輸入

添加到當前的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

uj5u.com熱心網友回復：

使用集合而不是字串來保存發票編號。然后回圈遍歷集合，創建一個最多包含 4 個發票的字串。

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
  
    'Set Dict = New Scripting.Dictionary 'Early Binding
    Set dict = CreateObject("Scripting.Dictionary") 'Late Binding
    
    'stores in an array all the data from columns B and C,
    'starting at B1 and up to the last row with data from column C.
    With Sheets("DO")
        lastrow = .Range("C" & Rows.count).End(xlUp).Row
        DataSet = .Range("B1:C" & lastrow)
    End With
    
    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) = key
                 DataSet(r, 2) = Trim(s) ' remove leading space
                 s = ""
            End If
        Next
    Next

    ' write re-used part of DataSet to sheet
    Sheets("DO").Range("E1").Resize(r, 2) = DataSet
    Set dict = Nothing
End Sub

uj5u.com熱心網友回復：

這是一個相當混亂的函式：

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)

標籤：擅长 vba 苹果系统 excel-公式

上一篇：BrewonMacOsforPhP版本

下一篇：如何使用每個檔案中的特定字串重命名檔案？