Vấn đề tính hàng tổng cộng sau khi lọc và sum trong xử lý mảng

Thảo luận trong 'Lập Trình với Excel' bắt đầu bởi Hoàng Trọng Nghĩa, 28 Tháng ba 2012.

  1. Hoàng Trọng Nghĩa

    Hoàng Trọng Nghĩa .: Never Stand Still :.

    Tôi có một bảng dữ liệu, sau khi lọc duy nhất rồi cộng dồn theo cột, nhưng lại vướng là muốn thêm 1 hàng dưới cùng để làm hàng tổng cộng của các cột.

    Xin vui lòng hướng dẫn.

    PHP:
    Private Sub SumDaTa()
        
    'On Error Resume Next
        Dim i As Long, iR As Long, iC As Long
        Dim sArray, Tmp, Arr()
        sArray = Range(Sheet2.[A1], Sheet2.[A65536].End(xlUp)).Resize(, 15)
        ReDim Arr(1 To UBound(sArray, 1), 1 To 15)
        iR = 0
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(sArray, 1)
                If sArray(i, 1) <> vbNullString Then
                    Tmp = sArray(i, 1)
                    If Not .Exists(Tmp) Then
                        iR = iR + 1
                        .Add Tmp, iR
                        Arr(iR, 1) = Tmp: Arr(iR, 2) = sArray(i, 2)
                        For iC = 3 To 15
                            Arr(iR, iC) = sArray(i, iC)
                        Next
                    Else
                        For iC = 3 To 15
                            Arr(.Item(Tmp), iC) = Arr(.Item(Tmp), iC) + sArray(i, iC)
                        Next
                    End If
                End If
            Next
        End With
        Sheet2.[R1].Resize(iR, 15).Value = Arr
    End Sub

     

    Các file đính kèm:

  2. concogia

    concogia Gội rồi mới Cạo

    Nếu không cần thể hiện côngt thức thì thêm tý mắm muối vào code
    Mã:
    Private Sub SumDaTa()
        'On Error Resume Next
        Dim i As Long, iR As Long, iC As Long, Tong
        Dim sArray, Tmp, Arr()
        sArray = Range(Sheet2.[A1], Sheet2.[A65536].End(xlUp)).Resize(, 15)
        ReDim Arr(1 To UBound(sArray, 1), 1 To 15)
        ReDim Tong(1 To 1, 2 To 15)
        Tong(1, 2) = "TONG CONG:"
        iR = 0
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(sArray, 1)
                If sArray(i, 1) <> vbNullString Then
                    Tmp = sArray(i, 1)
                    If Not .Exists(Tmp) Then
                        iR = iR + 1
                        .Add Tmp, iR
                        Arr(iR, 1) = Tmp: Arr(iR, 2) = sArray(i, 2)
                        For iC = 3 To 15
                            Arr(iR, iC) = sArray(i, iC)
                         If i > 1 Then Tong(1, iC) = Tong(1, iC) + sArray(i, iC)
                        Next
                    Else
                        For iC = 3 To 15
                            Arr(.Item(Tmp), iC) = Arr(.Item(Tmp), iC) + sArray(i, iC)
                            Tong(1, iC) = Tong(1, iC) + sArray(i, iC)
                        Next
                    End If
                End If
            Next
        End With
        Sheet2.[R1].Resize(iR, 15).Value = Arr
        [S1000].End(xlUp)(2).Resize(, 14) = Tong
    End Sub
    
    
    Híc
     
  3. Hoàng Trọng Nghĩa

    Hoàng Trọng Nghĩa .: Never Stand Still :.

    Hè hè, Bác Cò "chơi mánh" nhập 2 lần, OK, rất linh hoạt., "Khéo ăn thì no khéo co thì ấm".

    Cám ơn Bác Cò nhé!
     
  4. Hoàng Trọng Nghĩa

    Hoàng Trọng Nghĩa .: Never Stand Still :.

    Nếu không muốn gán 2 lần xuống sheet, thì thêm 1 Rờ-Dim nữa đúng không Bác Cò? hè hè.
    Với code này, 64525 dòng và 54 cột đều có dữ liệu, chỉ mất gần 10 giây để thực hiện:

    PHP:
    Private Sub SumDaTa3()
        
    Dim i As LongAs LongAs LongiR As LongiC As Long
        Dim sArray
    TmpArrTongGrossTotal
        sArray 
    Range(Sheet2.[A1], Sheet2.[A65536].End(xlUp)).Resize(, 54)
        
    ReDim Arr(1 To UBound(sArray1), 1 To 54)
        
    ReDim Tong(1 To 11 To 54)
        
    Tong(12) = "TONG CONG:"
        
    iR 0
        With CreateObject
    ("Scripting.Dictionary")
            For 
    1 To UBound(sArray1)
                If 
    sArray(i1) <> vbNullString Then
                    Tmp 
    sArray(i1)
                    If 
    Not .Exists(TmpThen
                        iR 
    iR 1
                        
    .Add TmpiR
                        Arr
    (iR1) = TmpArr(iR2) = sArray(i2)
                        For 
    iC 3 To 54
                            Arr
    (iRiC) = sArray(iiC)
                            If 
    1 Then Tong(1iC) = Tong(1iC) + sArray(iiC)
                        
    Next
                    
    Else
                        For 
    iC 3 To 54
                            Arr
    (.Item(Tmp), iC) = Arr(.Item(Tmp), iC) + sArray(iiC)
                            
    Tong(1iC) = Tong(1iC) + sArray(iiC)
                        
    Next
                    End 
    If
                
    End If
            
    Next
        End With
        j 
    iR 1
        ReDim GrossTotal
    (1 To j1 To 54)
        For 
    1 To j
            
    For 1 To 54
                
    If j Then
                    GrossTotal
    (ik) = Tong(1k)
                Else
                    
    GrossTotal(ik) = Arr(ik)
                
    End If
            
    Next
        Next
        Sheet2
    .[BD1].Resize(j54).Value GrossTotal
    End Sub

     
    Last edited: 28 Tháng ba 2012

Chia sẻ trang này