quocthan92
Thành viên mới
- Tham gia
- 23/3/17
- Bài viết
- 34
- Được thích
- 0
Bạn chạy thử Sub này từ Module.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 đỡ
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
Thử tìm hiểu cái này xem...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 đỡ
Anh Ba Tê đúng là thánh code, em suy nghĩ cả đêm hôm qua vẫn không ra.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
Nếu bạn định dùng bài này để tập viết code thì tôi không bàn đếnMì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 codeMì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 đỡ
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
A Ba Tê, em hỏi ngoài lề 1 tí..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
Provider phải install thêm gì để debug bácGó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