Giúp code tổng hợp (1 người xem)

tueyennhi · 27/9/16

Chào anh chị.

Em có file dữ liệu với nhiều sheet khác nhau, có cách nào chạy file lọc lấy giá trị cột ID của tất cả các sheet kia vào sheet tổng hợp không ạ? Với điều kiện ID trong sheet tổng hợp là duy nhất (chỉ lấy ID khác biệt vào file tổng hợp, không lặp lại các ID đã có.

Em cảm ơn.

tueyennhi · 28/9/16

Anh SA ơi anh đã ngủ chưa ạ? Máy em bị đơ hẳn rồi

. Có thuật toán nào nhanh hơn không anh?

ChanhTQ@ · 29/9/16

Anh ơi? Máy em bị đơ hẳn rồi . Có thuật toán nào nhanh hơn không anh?

Trong khi chờ đợi giải thuật khả dĩ hơn từ cộng đồng , bạn có thể tăng dần số người xử lý lên xem sao; Ví dụ

PHP:

Số người | Thời gian
   220    |   23"                   "
   500    |   ?
   999    |   ??
  1500    |  ???
  2000    | ???

quanluu · 29/9/16

Hiện tại mình vẫn chưa biết code mà bạn bảo là bị sai chỗ nào, nhưng cứ đưa code tổng quát lên để bạn tham khảo

Mã:

Sub test()
Dim cn As Object, sh As Worksheet
Dim i As Integer, timm As Double
timm = Timer
Set cn = CreateObject("ADODB.Connection")
With cn
    For Each sh In ThisWorkbook.Sheets
        .Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
        If sh.Name <> "BCC" Then
            For i = 8 To 158
                If Sheets("BCC").Cells(6, i) <> "" And Day(Sheets("BCC").Cells(6, i)) = Val(sh.Name) Then
                    Sheets("BCC").Cells(8, i).CopyFromRecordset .Execute("select b.f33, b.f34,b.f35, '', b.f38 from [BCC$B8:B3466] a left join [" & sh.Name & "$C9:AN4000] b on b.f1 = a.f1")
                    Exit For
                End If
            Next
        End If
        .Close
    Next
End With
Set cn = Nothing
MsgBox (Timer - timm)
End Sub

SA_DQ · 29/9/16

Theo mình nghĩ thì cău lệnh If này tiềm ẩn nguy cơ sai fạm do thiết kế trang 'BCC' đem lại;
Thứ nhất: Các ngày trong các tháng là khác nhau;
Cho nên tại dòng 6 của 'BCC' từ cột [H] trở về sau không nên là số liệu ngày tháng; mà chỉ nên là số liệu ngày (của bất kì tháng nào trong năm)
Ví dụ 26, 27, 28, . . . . . .
& như thế, tháng nào chỉ 29 ngày thì các cột thuộc về ngày 30 hay 31 sẽ không được chương trình nhập số liệu

Nếu không là cách này thì cách khác sẽ fức tạp hơn; Như ta luôn ghi ngày 01 của tháng chấm công cố định vô cột [AL]; Ngày trước ngày 01 này sẽ fải ở cột [AG], cho dù nó là ngày nào của cuối tháng trước

Thứ hai: . . . . . (sẽ viết) --=0

tueyennhi · 29/9/16

quanluu1989 đã viết:
Mình hiểu cái đó, bạn có thể chỉ ra cái nào ko đúng ko? bạn thử thay "on b.f1 = a.f1" bằng on b.f1 = a.f1 order by a.f1 coi có chuẩn ko?

Thay xong chạy báo lỗi Run time error
Syntax erro in Order by clause

quanluu · 29/9/16

SA_DQ đã viết:
Theo mình nghĩ thì cău lệnh If này tiềm ẩn nguy cơ sai fạm do thiết kế trang 'BCC' đem lại;
Thứ nhất: Các ngày trong các tháng là khác nhau;
Cho nên tại dòng 6 của 'BCC' từ cột [H] trở về sau không nên là số liệu ngày tháng; mà chỉ nên là số liệu ngày (của bất kì tháng nào trong năm)
Ví dụ 26, 27, 28, . . . . . .
& như thế, tháng nào chỉ 29 ngày thì các cột thuộc về ngày 30 hay 31 sẽ không được chương trình nhập số liệu

Nếu không là cách này thì cách khác sẽ fức tạp hơn; Như ta luôn ghi ngày 01 của tháng chấm công cố định vô cột [AL]; Ngày trước ngày 01 này sẽ fải ở cột [AG], cho dù nó là ngày nào của cuối tháng trước

Thứ hai: . . . . . (sẽ viết)

Mình vẫn chưa hiểu hết ý của bạn, thực chất ban đầu mình chỉ viết "Day(Sheets("BCC").Cells(6, i)) = Val(sh.Name)" thui nhưng thấy day(cell rông) = 30 nên mình phải thêm đk khác rỗng

Còn mình nghĩ cái này đọc theo tên sheet trc, sau đó dò date nào có ngày trùng với tên sheet thì điền kết quả. nên mình vẫn chưa nhìn thấy có vấn đề gì ở dòng If này cả.

quanluu · 29/9/16

tueyennhi đã viết:
Thay xong chạy báo lỗi Run time error
Syntax erro in Order by clause

Bạn chạy thử code tổng hợp #43 xem thế nào. Còn vấn đề lỗi của bạn thì còn phải xem lại code bạn đã sửa đúng chưa thui.

tueyennhi · 29/9/16

quanluu1989 đã viết:
Bạn chạy thử code tổng hợp #43 xem thế nào. Còn vấn đề lỗi của bạn thì còn phải xem lại code bạn đã sửa đúng chưa thui.

Em chạy thử rồi, dữ liệu đưa vào không đủ và đúng anh ạ.

quanluu · 29/9/16

tueyennhi đã viết:
Em chạy thử rồi, dữ liệu đưa vào không đủ và đúng anh ạ.

Mình vẫn chưa thấy bạn nêu ra ví dụ không đủ chỗ nào, ko đúng chỗ nào. Mình test với fiile mẫu của bạn thì thấy có vấn đề gì đâu nhỉ?

tueyennhi · 29/9/16

quanluu1989 đã viết:
Mình vẫn chưa thấy bạn nêu ra ví dụ không đủ chỗ nào, ko đúng chỗ nào. Mình test với fiile mẫu của bạn thì thấy có vấn đề gì đâu nhỉ?

File chạy đến dòng 3400 thì không thấy quét dữ liệu vào nữa. Các dòng ở trên cũng chỉ quét đôi ngày chứ không đầy đủ.

quanluu · 29/9/16

tueyennhi đã viết:
File chạy đến dòng 3400 thì không thấy quét dữ liệu vào nữa. Các dòng ở trên cũng chỉ quét đôi ngày chứ không đầy đủ.

Bạn đã check với file bạn đính kèm mẫu chưa? hay bạn check luôn với file thật của bạn?
Mình đã check với file mẫu đính kèm thì ra toàn bộ kêt quả. Nếu bạn ko ngại thì bạn up lên 1 it dữ liệu file thật, như thế mới biết đc vấn đề.

ChanhTQ@ · 29/9/16

Bạn có thể chạy với macro này trong khi chờ những cái khác tốt hơn:

PHP:

Option Explicit
Sub FindTHCong()
 Dim W As Long, J As Long, Rws As Long, Dm As Byte, Ng As Byte, Col As Byte, Tmr As Double
 Dim Rng As Range, Sh As Worksheet, Arr(), sRng As Range
 Dim ShName As String
 
 Sheets("BCC").Select:                      Tmr = Timer()
 Rws = [h6].CurrentRegion.Rows.Count
 For Each Sh In ThisWorkbook.Worksheets
    If IsNumeric(Sh.Name) Then
        ShName = ShName & Sh.Name
    End If
 Next Sh
 Set Rng = Range([B8], [B8].End(xlDown))
 Arr() = Rng.Value
 ReDim dArr(1 To Rng.Rows.Count, 1 To 155)
 For J = 1 To UBound(Arr())
    For Dm = 1 To Len(ShName) Step 2
        Set Sh = ThisWorkbook.Worksheets(Mid(ShName, Dm, 2))
        Ng = CByte(Mid(ShName, Dm, 2))
        If Ng > 25 Then
            Col = (Ng - 26) * 5 + 1
        Else
            Col = 26 + Ng * 5
        End If
        Set Rng = Sh.Range(Sh.[C9], Sh.[C9].End(xlDown))
        Set sRng = Rng.Find(Arr(J, 1), , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then
            dArr(J, Col) = sRng.Offset(, 32).Value
            dArr(J, Col + 1) = sRng.Offset(, 33).Value
            dArr(J, Col + 2) = sRng.Offset(, 34).Value
            dArr(J, Col + 3) = sRng.Offset(, 37).Value
        End If
    Next Dm
 Next J
 [H8].Resize(J, 155).Value = dArr()
 MsgBox Timer() - Tmr
End Sub

tueyennhi · 29/9/16

ChanhTQ@ đã viết:
Bạn có thể chạy với macro này trong khi chờ những cái khác tốt hơn:

End Sub...

Thuật toán đã nhanh hơn nhiều cụ thể

220 người mất 9s
500 người mất 18s
1000 người mất 43s
2000 người mất 82s
4200 người mất 195s

Như vậy là đã quá nhanh rồi anh ạ, cảm ơn anh nhé. Dữ liệu check xác suất không thấy sai cái nào

Sau khi chỉnh sửa thêm dòng lệnh

dArr(J, Col) = sRng.Offset(, 32).Value
dArr(J, Col + 1) = sRng.Offset(, 33).Value
dArr(J, Col + 2) = sRng.Offset(, 34).Value
dArr(J, Col + 3) = sRng.Offset(, 35).Value
dArr(J, Col + 4) = sRng.Offset(, 37).Value

Thời gian có tăng thêm một chút mất 228s như vậy là tuyệt rồi anh ạ, có một thắc mắc là ở dòng cuối cùng sẽ để lại giá trị #n/a là sao anh nhỉ?

SA_DQ · 29/9/16

; Có một thắc mắc là ở dòng cuối cùng sẽ để lại giá trị #n/a là sao anh nhỉ?

Để khắc fục hiện tượng này, bạn sửa câu lệnh liên quan lại như sau:

Mã:

[H8].Resize(J - 1, 155).Value = dArr()

À có thể thêm 1 câu lệnh này

PHP:

If Arr(J, 1) = "" Then Exit For

vô sau dòng

Mã:

For J = 1 To UBound(Arr())

cho có vẻ chuyên nghiệp!

Chúc vui!

tueyennhi · 29/9/16

Dạ vâng anh, giá được làm đệ của anh thì tốt biết mấy, em sẽ học hỏi được nhiều!

Cho em hỏi thêm dòng lệnh sau

Sub Lay_ID()
Dim Dic, ws As Worksheet, iRow As Long, i As Long, Arr(), TmpArr, Tmp
On Error Resume Next
Application.ScreenUpdating = False
Sheet25.Range("b8:b5000").ClearContents
Set Dic = CreateObject("Scripting.Dictionary")
For Each ws In Worksheets
If ws.Name <> Sheet25 Then
TmpArr = ws.Range(ws.[c8], ws.[c5000].End(xlUp)).Value
For iRow = 1 To UBound(TmpArr, 1)
Tmp = TmpArr(iRow, 1)
If Not IsEmpty(Tmp) Then
If Not Dic.Exists(Tmp) Then
Dic.Add Tmp, ""
i = i + 1
ReDim Preserve Arr(1 To 1, 1 To i)
Arr(1, i) = TmpArr(iRow, 1)
'.................................
End If
End If
Next
End If
Next
With Sheet25
.Range("b8").Resize(i, 1) = WorksheetFunction.Transpose(Arr)

End With
Application.ScreenUpdating = True
End Sub

Dùng để tổng hợp toàn bộ ID từ các sheet công. Nhưng em thấy có gì đó sai bởi vì luôn xuất hiện ID có tên là Name mặc dù toàn bộ cột ID của trang tính công em không thấy giá trị Name nào cả. Theo em hiểu thì dòng lệnh quét cột ID của các sheet chấm công từ C8 đến C5000. Có đúng như vậy không ạ? Như vậy thì ở BCC phải có ID là ID chứ sao lại là Name? @@

Ba Tê · 29/9/16

Tôi không theo dõi các bài viết đầy đủ, chỉ hiểu và làm theo file đính kèm bài #33 của bạn.
Xem thử kết quả thế nào nhé.

tueyennhi · 29/9/16

Ba Tê đã viết:
Tôi không theo dõi các bài viết đầy đủ, chỉ hiểu và làm theo file đính kèm bài #33 của bạn.
Xem thử kết quả thế nào nhé.

Quá nhanh, mọi người giỏi quá mà chẳng ở gần đây !$@!!

. Cảm ơn anh!

SA_DQ · 29/9/16

. . . chỉ hiểu và làm theo file đính kèm bài #33 của bạn.
Xem thử kết quả thế nào nhé.

Một khi trang 'BCC' là 4.200 dòng & 31 trang chấm công có cở 3.800-4.000 dòng là biết nhau ngay í mà;

Biết rằng trong 31 trang chấm công í, thì trong 1.850 dòng trung bình í chỉ đi tìm 1 dòng có đúng mã thôi;
Vế điều này thì tìm trong mảng lại chậm hơn fương thức FIND(); Mình vừa thử xong sáng nay mới dám khẳng định như vậy!
--=0

tueyennhi · 29/9/16

SA_DQ đã viết:
Một khi trang 'BCC' là 4.200 dòng & 31 trang chấm công có cở 3.800-4.000 dòng là biết nhau ngay í mà;

Biết rằng trong 31 trang chấm công í, thì trong 1.850 dòng trung bình í chỉ đi tìm 1 dòng có đúng mã thôi;
Vế điều này thì tìm trong mảng lại chậm hơn fương thức FIND(); Mình vừa thử xong sáng nay mới dám khẳng định như vậy!

Chả hiểu anh nói gì +-+-+-+

thế cái này hơn à anh $-\\/.$

SA_DQ · 29/9/16

Chả hiểu anh nói gì thế cái này hơn à anh

Vì macro í chỉ chạy trên 2 trang tính thôi; nếu đủ 31+1 trang sẽ khác đó;
Còn đây là macro lập danh sách duy nhất từ 31 trang chấm công nè:

PHP:

Option Explicit
Sub LapDSDuyNhatTu31Trang()
 Dim Rw As Long, W As Long, J As Long
 Dim TmpArr(), Dic1 As Object, Sh As Worksheet
 Set Dic1 = CreateObject("Scripting.Dictionary")
 ReDim Arr(1 To 5000, 1 To 1) As Long
 For Each Sh In ThisWorkbook.Worksheets
    If IsNumeric(Sh.Name) Then
        TmpArr() = Sh.Range(Sh.[c9], Sh.[c9].End(xlDown)).Value
        For J = 1 To UBound(TmpArr())
            If Not Dic1.exists(TmpArr(J, 1)) Then
                W = W + 1:          Arr(W, 1) = TmpArr(J, 1)
                Dic1.Add TmpArr(J, 1), W
            End If
        Next J
    End If
 Next Sh
 If W Then
    Sheets("BCC").[b8].Resize(W).Value = Arr()
 End If
End Sub

Giúp code tổng hợp (1 người xem)

Người dùng đang xem chủ đề này

Thành viên tích cực

File đính kèm

Thành viên tích cực

0901452không62

Thành viên gắn bó

/(hông là gì!

Thành viên tích cực

Thành viên gắn bó

Thành viên gắn bó

Thành viên tích cực

Thành viên gắn bó

Thành viên tích cực

Thành viên gắn bó

0901452không62

Thành viên tích cực

/(hông là gì!

Thành viên tích cực

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên tích cực

/(hông là gì!

Thành viên tích cực

/(hông là gì!

Đếm ngược thời gian