Lọc Dữ Liệu Và Tính Trung Bình (1 người xem)

[xuanloi0105]

Chào các Anh (Chị ) trên diễn đàn, em có 1 vấn đề đang cần làm báo cáo mà chưa thành thạo code VBA như sau :
+ Em có 1 file số liệu đã trích xuất ( file đính kèm ).
+ Em muốn tạo 1 nút "FIlter" dùng code VBA với mục đích tạo ra 1 bảng khác với mong muốn :
- Những dữ liệu nào cùng "Số Mẻ" thì sẽ tính trung bình cộng của các dữ liệu ở các cột D,E,F tương ứng.
- Riêng ở cột G em chỉ cần dữ liệu cuối cùng của 1 mẻ ( Ví dụ ở mẻ 1 em chỉ cần giá trị ở ô G15)
+ Mong nhận được sự hỗ trợ ! Thanks !

 

[PacificPR]

Biết đặt Pass cho Code là thành thạo hơn mình rồi. Vậy mà nói chưa thành thạo VBA

 

[SA_DQ]

VBE đã cài mật khẩu; Vĩnh biệt!

 

[xuanloi0105]

Biết đặt Pass cho Code là thành thạo hơn mình rồi. Vậy mà nói chưa thành thạo VBA

VBA đi xin ạ ). Nhưng mà cái code đấy chỉ để lấy dữ liệu ra thôi ạ. Vấn đề là có dữ liệu rồi thì xử lý như nào thôi ^^

 

[Lê Duy Thương]

VBA đi xin ạ ). Nhưng mà cái code đấy chỉ để lấy dữ liệu ra thôi ạ. Vấn đề là có dữ liệu rồi thì xử lý như nào thôi ^^

Cài đặt PasS vba THì AI XEM CODE được Mà GIải THích.

 

[xuanloi0105]

VBE đã cài mật khẩu; Vĩnh biệt!

Pass : Admin ạ

 

[Hoang2013]

Sub ArrayTH()
 Dim Rws As Long, W As Long, J As Long, Dem As Integer
 Dim PP As Double, FF As Double, hh As Double, SoMe As Integer, Tmr As Double
 Dim Arr():                                 Dim Ca As String
 Rws = [b11].CurrentRegion.Rows.Count
 Arr() = [A11].Resize(Rws, 7).Value
 ReDim dArr(1 To UBound(Arr()), 1 To 7)
 [i11].Resize(Rws, 7).Value = ""
 For J = 1 To UBound(Arr())
    If Arr(J, 1) = "" Then Exit For
    If Arr(J, 2) <> SoMe Then
        If J = 1 Then
            Dem = 1 + Dem:                  Ca = Arr(J, 1)
            SoMe = Arr(J, 2):               PP = Arr(J, 4)
            FF = Arr(J, 5):                 hh = Arr(J, 6)
        ElseIf J > 1 Then
            On Error Resume Next
            W = W + 1
            dArr(W, 1) = Ca:                dArr(W, 2) = SoMe
            dArr(W, 3) = Arr(J - 1, 3):     dArr(W, 4) = PP / Dem
            dArr(W, 5) = FF / Dem:          dArr(W, 6) = hh / Dem
            dArr(W, 7) = Arr(J - 1, 7):     Dem = 0
            FF = 0:                         PP = 0
            hh = 0:                         SoMe = Arr(J, 2)
        End If
    Else
        Dem = Dem + 1:                      PP = PP + Arr(J, 4)
        FF = FF + Arr(J, 5):                hh = hh + Arr(J, 6)
    End If
 Next J
 If W Then
    [i11].Resize(W, 7).Value = dArr()
 End If
End Sub

 

[Ba Tê]

Pass : Admin ạ

Rút kinh nghiệm: Trước khi gởi file, gỡ bỏ tất cả PW (hoặc báo rõ PW là gì), nên làm kết quả mẫu cho người khác trực quan để "cố hiểu" bạn muốn gì.
Vì: Mình giải thích có khi chỉ mình hiểu (hoặc những người cùng ngành nghề với mình mới hiểu), người khác đọc xong chẳng biết mình muốn gì, sao giúp cho đúng được.
Tôi thì chỉ hiểu được thế này:

Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Num As Long, SoMe As Long
sArr = Range("B11", Range("B11").End(xlDown)).Resize(, 6).Value
R = UBound(sArr): ReDim dArr(1 To R, 1 To 7)
For I = 1 To R
    If sArr(I, 1) <> SoMe Then
        K = K + 1: dArr(K, 1) = sArr(I, 1): SoMe = sArr(I, 1)
    End If
    dArr(K, 2) = dArr(K, 2) + sArr(I, 3): dArr(K, 3) = dArr(K, 3) + sArr(I, 4)
    dArr(K, 4) = dArr(K, 4) + sArr(I, 5): dArr(K, 5) = sArr(I, 6): dArr(K, 7) = dArr(K, 7) + 1
Next I
For I = 1 To K
    Num = dArr(I, 7): dArr(I, 2) = dArr(I, 2) / Num
    dArr(I, 3) = dArr(I, 3) / Num: dArr(I, 4) = dArr(I, 4) / Num
Next I
Range("K11").Resize(K, 5) = dArr
End Sub

 

[Lê Duy Thương]

Rút kinh nghiệm: Trước khi gởi file, gỡ bỏ tất cả PW (hoặc báo rõ PW là gì), nên làm kết quả mẫu cho người khác trực quan để "cố hiểu" bạn muốn gì.
Vì: Mình giải thích có khi chỉ mình hiểu (hoặc những người cùng ngành nghề với mình mới hiểu), người khác đọc xong chẳng biết mình muốn gì, sao giúp cho đúng được.
Tôi thì chỉ hiểu được thế này:

Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Num As Long, SoMe As Long
sArr = Range("B11", Range("B11").End(xlDown)).Resize(, 6).Value
R = UBound(sArr): ReDim dArr(1 To R, 1 To 7)
For I = 1 To R
    If sArr(I, 1) <> SoMe Then
        K = K + 1: dArr(K, 1) = sArr(I, 1): SoMe = sArr(I, 1)
    End If
    dArr(K, 2) = dArr(K, 2) + sArr(I, 3): dArr(K, 3) = dArr(K, 3) + sArr(I, 4)
    dArr(K, 4) = dArr(K, 4) + sArr(I, 5): dArr(K, 5) = sArr(I, 6): dArr(K, 7) = dArr(K, 7) + 1
Next I
For I = 1 To K
    Num = dArr(I, 7): dArr(I, 2) = dArr(I, 2) / Num
    dArr(I, 3) = dArr(I, 3) / Num: dArr(I, 4) = dArr(I, 4) / Num
Next I
Range("K11").Resize(K, 5) = dArr
End Sub

cái này pivot table cũng quá ok rồi anh

 

[xuanloi0105]

Rút kinh nghiệm: Trước khi gởi file, gỡ bỏ tất cả PW (hoặc báo rõ PW là gì), nên làm kết quả mẫu cho người khác trực quan để "cố hiểu" bạn muốn gì.
Vì: Mình giải thích có khi chỉ mình hiểu (hoặc những người cùng ngành nghề với mình mới hiểu), người khác đọc xong chẳng biết mình muốn gì, sao giúp cho đúng được.
Tôi thì chỉ hiểu được thế này:

Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Num As Long, SoMe As Long
sArr = Range("B11", Range("B11").End(xlDown)).Resize(, 6).Value
R = UBound(sArr): ReDim dArr(1 To R, 1 To 7)
For I = 1 To R
    If sArr(I, 1) <> SoMe Then
        K = K + 1: dArr(K, 1) = sArr(I, 1): SoMe = sArr(I, 1)
    End If
    dArr(K, 2) = dArr(K, 2) + sArr(I, 3): dArr(K, 3) = dArr(K, 3) + sArr(I, 4)
    dArr(K, 4) = dArr(K, 4) + sArr(I, 5): dArr(K, 5) = sArr(I, 6): dArr(K, 7) = dArr(K, 7) + 1
Next I
For I = 1 To K
    Num = dArr(I, 7): dArr(I, 2) = dArr(I, 2) / Num
    dArr(I, 3) = dArr(I, 3) / Num: dArr(I, 4) = dArr(I, 4) / Num
Next I
Range("K11").Resize(K, 5) = dArr
End Sub

Vâng, cảm ơn chú nhiều ạ !