LỌC TRÙNG DATA BẰNG VBA

Liên hệ QC

quocthan92

Thành viên mới
Tham gia
23/3/17
Bài viết
34
Được thích
0
Mình có 1 vấn đề là lọc nhiều model trùng nhau thành 1 và sum số lượng, lấy ngày giờ bắt đầu đến giờ kết thúc

Rất mong được sự giúp đỡ
 

File đính kèm

  • test.xlsm
    21.1 KB · Đọc: 20
Mình có 1 vấn đề là lọc nhiều model trùng nhau thành 1 và sum số lượng, lấy ngày giờ bắt đầu đến giờ kết thúc

Rất mong được sự giúp đỡ
Bạn chạy thử Sub này từ Module.
PHP:
Public Sub GPE()
Dim sArr(), I As Long, J As Long, K As Long, R As Long, Tem As String
With Sheets("data")
    sArr = .Range("A1", .Range("A1").End(xlDown)).Resize(, 8).Value
    R = UBound(sArr): ReDim dArr(1 To R, 1 To 8)
End With
For I = 1 To R
    If sArr(I, 1) & "#" & sArr(I, 4) <> Tem Then
        K = K + 1
        Tem = sArr(I, 1) & "#" & sArr(I, 4)
        For J = 1 To 8
            dArr(K, J) = sArr(I, J)
        Next J
    Else
        dArr(K, 5) = dArr(K, 5) + sArr(I, 5)
        dArr(K, 8) = sArr(I, 8)
    End If
Next I
Sheets("result").Range("A1").Resize(K, 8) = dArr
End Sub
 
Upvote 0
Upvote 0
Bạn chạy thử Sub này từ Module.
PHP:
Public Sub GPE()
Dim sArr(), I As Long, J As Long, K As Long, R As Long, Tem As String
With Sheets("data")
    sArr = .Range("A1", .Range("A1").End(xlDown)).Resize(, 8).Value
    R = UBound(sArr): ReDim dArr(1 To R, 1 To 8)
End With
For I = 1 To R
    If sArr(I, 1) & "#" & sArr(I, 4) <> Tem Then
        K = K + 1
        Tem = sArr(I, 1) & "#" & sArr(I, 4)
        For J = 1 To 8
            dArr(K, J) = sArr(I, J)
        Next J
    Else
        dArr(K, 5) = dArr(K, 5) + sArr(I, 5)
        dArr(K, 8) = sArr(I, 8)
    End If
Next I
Sheets("result").Range("A1").Resize(K, 8) = dArr
End Sub
Anh Ba Tê đúng là thánh code, em suy nghĩ cả đêm hôm qua vẫn không ra.
 
Upvote 0
Mình có 1 vấn đề là lọc nhiều model trùng nhau thành 1 và sum số lượng, lấy ngày giờ bắt đầu đến giờ kết thúc

Rất mong được sự giúp đỡ
Nếu bạn định dùng bài này để tập viết code thì tôi không bàn đến
Nếu bạn định xử lý bài toán cho CÔNG VIỆC, tôi khuyên bạn dùng PivotTable, bởi nó quá đơn giản, chỉ làm 1 lần duy nhất rồi dùng mãi mãi
 
Upvote 0
Mình có 1 vấn đề là lọc nhiều model trùng nhau thành 1 và sum số lượng, lấy ngày giờ bắt đầu đến giờ kết thúc

Rất mong được sự giúp đỡ
Góp vui thêm code
Mã:
Sub tong()
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
    Sheets("result").Range("A2").CopyFromRecordset cn.Execute("select f1, f2, f3, f4, sum(f5), f6, min(f7), max(f8) from [data$] group by f1, f2, f3, f4, f6")
End Sub
 
Upvote 0
Bạn chạy thử Sub này từ Module.
PHP:
Public Sub GPE()
Dim sArr(), I As Long, J As Long, K As Long, R As Long, Tem As String
With Sheets("data")
    sArr = .Range("A1", .Range("A1").End(xlDown)).Resize(, 8).Value
    R = UBound(sArr): ReDim dArr(1 To R, 1 To 8)
End With
For I = 1 To R
    If sArr(I, 1) & "#" & sArr(I, 4) <> Tem Then
        K = K + 1
        Tem = sArr(I, 1) & "#" & sArr(I, 4)
        For J = 1 To 8
            dArr(K, J) = sArr(I, J)
        Next J
    Else
        dArr(K, 5) = dArr(K, 5) + sArr(I, 5)
        dArr(K, 8) = sArr(I, 8)
    End If
Next I
Sheets("result").Range("A1").Resize(K, 8) = dArr
End Sub
A Ba Tê, em hỏi ngoài lề 1 tí..
1. sao em không thay With Sheet("data") .. End With bằng With Sheet2 .. End With
2. vì có 1 file excel không biết format gì mà thay đổi tên workbook thì tên sheet cũng thay đổi theo nên em không để Sheet("data") mặc định được
 
Upvote 0
Góp vui thêm code
Mã:
Sub tong()
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
    Sheets("result").Range("A2").CopyFromRecordset cn.Execute("select f1, f2, f3, f4, sum(f5), f6, min(f7), max(f8) from [data$] group by f1, f2, f3, f4, f6")
End Sub
Provider phải install thêm gì để debug bác
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom