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

[tueyennhi]

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]

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è:

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

Em chạy trên 31 trang tính mà anh?? Hết hơn 3s. Nói gì thì nói với cái xã hội nhà nước bây giờ khi lên forum mình được bao thế hệ đàn anh giúp đỡ em cảm thấy thật xúc động. Cái này là suy nghĩ thật của em (em vừa tu rượu với bố vợ em trai). Cảm ơn mọi người rất nhiều!

 

[HieuCD]

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è:

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

code của bạn Ba Tê không cần có danh sách cột B, làm 2 việc tạo danh sách và lấy dữ liệu chấm công
muốn chạy code của bạn SA_DQ phải có danh sách cột B, nếu chưa có phải dùng code của bạn, và phải duyệt qua tất cả các dòng của 31 sheet chấm công

 

[SA_DQ]

Em chạy trên 31 trang tính mà anh?? Hết hơn 3s. . . . Cảm ơn mọi người rất nhiều!

Vậy hả; Mình thấy chỉ 2 trang tính trong file thầy 3 Tê nên nói vậy; Chứ thật ra mình chưa thử!

 

[tueyennhi]

Vậy hả; Mình thấy chỉ 2 trang tính trong file thầy 3 Tê nên nói vậy; Chứ thật ra mình chưa thử!

Thầy Ba tê cơ à anh bài của em được nhiều cao nhân để ý quá . Em up vào file của em chạy khoái lắm, thật không thể tin được

 

[tueyennhi]

Cho em hỏi ngoài lề một chút về tính tổng có điều kiện. Mọi người xem file nhé.

 

[Ba Tê]

Cho em hỏi ngoài lề một chút

Đối với hàm

=+SUMIF(A1:I1,">5",A2:I2)

Có cách nào thay ">5" bằng giá trị 5 trong một ô nào đó được không ạ?

=SUMIF(Vùng nào đó,">" & ô nào đó,Vùng nào đó)

 

[ChanhTQ@]

Cố đuổi theo Thầy Ba Tê cái coi:

Option Explicit
Sub TongHopTu31Trang()
 Dim Rw As Long, W As Long, J As Long, Ng As Byte, Col As Byte, Tmr As Double
 Dim TmpArr(), Dic1 As Object, Sh As Worksheet
 Set Dic1 = CreateObject("Scripting.Dictionary")
 ReDim Arr(1 To 5000, 1 To 161):                    Tmr = Timer()
 For Each Sh In ThisWorkbook.Worksheets
    If IsNumeric(Sh.Name) Then
        TmpArr() = Sh.Range(Sh.[c9], Sh.[c9].End(xlDown)).Resize(, 38).Value
        Ng = CByte(Sh.Name)
        If Ng > 25 Then
            Col = (Ng - 25) * 5 + 2
        Else
            Col = 32 + Ng * 5
        End If
        For J = 1 To UBound(TmpArr())
            If Not Dic1.exists(TmpArr(J, 1)) Then
                W = W + 1:                          Arr(W, 1) = TmpArr(J, 1)
                Arr(W, 2) = TmpArr(J, 2):           Dic1.Add TmpArr(J, 1), W
                
                Arr(W, Col) = TmpArr(J, 33):        Arr(W, Col + 1) = TmpArr(J, 34)
                Arr(W, Col + 2) = TmpArr(J, 35):    Arr(W, Col + 3) = TmpArr(J, 36)
                Arr(W, Col + 4) = TmpArr(J, 38)
            Else
                Arr(Dic1.Item(TmpArr(J, 1)), Col) = TmpArr(J, 33)
                Arr(Dic1.Item(TmpArr(J, 1)), Col + 1) = TmpArr(J, 34)
                Arr(Dic1.Item(TmpArr(J, 1)), Col + 2) = TmpArr(J, 35)
                Arr(Dic1.Item(TmpArr(J, 1)), Col + 3) = TmpArr(J, 36)
                Arr(Dic1.Item(TmpArr(J, 1)), Col + 4) = TmpArr(J, 38)
            End If
        Next J
    End If
 Next Sh
 If W Then
    Sheets("BCC").[b8].Resize(W, 161).Value = Arr()
    Sheets("BCC").[g1].Value = Timer() - Tmr
 End If
End Sub

 

[Ba Tê]

Cố đuổi theo Thầy Ba Tê cái coi:

Sao Anh không lấy luôn cột B?

Sub TongHopTu31Trang()
 Dim Rw As Long, W As Long, J As Long, Ng As Byte, Col As Byte, Tmr As Double
 Dim TmpArr(), Dic1 As Object, Sh As Worksheet
 Set Dic1 = CreateObject("Scripting.Dictionary")
 ReDim Arr(1 To 5000, 1 To 161):                    Tmr = Timer()
 For Each Sh In ThisWorkbook.Worksheets
    If IsNumeric(Sh.Name) Then
        TmpArr() = Sh.Range(Sh.[c9], Sh.[c9].End(xlDown)).Resize(, 38).Value
        Ng = CByte(Sh.Name)
        If Ng > 25 Then
            Col = (Ng - 25) * 5 + 2
        Else
            Col = 32 + Ng * 5
        End If
        For J = 1 To UBound(TmpArr())
            If Not Dic1.exists(TmpArr(J, 1)) Then
                W = W + 1: Dic1.Add TmpArr(J, 1), W:    Arr(W, 1) = TmpArr(J, 1)
            End If
            Rw = Dic1.Item(TmpArr(J, 1))
                Arr(Rw, Col) = TmpArr(J, 33)
                Arr(Rw, Col + 1) = TmpArr(J, 34):       Arr(Rw, Col + 2) = TmpArr(J, 35)
                Arr(Rw, Col + 3) = TmpArr(J, 36):       Arr(Rw, Col + 4) = TmpArr(J, 38)
        Next J
    End If
 Next Sh
 If W Then
    Sheets("BCC").[b8].Resize(W, 161).Value = Arr()
    Sheets("BCC").[g1].Value = Timer() - Tmr
 End If
Set Dic1=Nothing
End Sub

 

[ChanhTQ@]

Cột trong các trang (để chấm công các ngày trong tháng) là thừa;
Mà chuyển từ tên trang tính sang cột (cho Array) cũng dễ mà!

 

[tueyennhi]

=SUMIF(Vùng nào đó,">" & ô nào đó,Vùng nào đó)

Vâng ạ, em cảm ơn anh nhiều !

 

[tueyennhi]

Cố đuổi theo Thầy Ba Tê cái coi:

Option Explicit

Em thấy hai thầy trò đang song hành

 

[Ba Tê]

Khi tôi chưa biết vba là gì, tôi phải học lóm của ChanhTQ@, nhất là "Chị" HYen17. Sau đó là học "chỉa" từ GPE. "GPE BAO LA".

 

[tueyennhi]

Khi tôi chưa biết vba là gì, tôi phải học lóm của ChanhTQ@, nhất là "Chị" HYen17. Sau đó là học "chỉa" từ GPE. "GPE BAO LA".

ChanhTQ là Trần Quốc Chanh à anh , có phải anh ở Hưng Yên không? Để đạt đến trình độ cao như bây giờ thầy Ba Tê đã học như thế nào? Em thì chỉ đụng cái nào học cái đấy, không hiểu cốt lõi, ví dụ như code của thầy

dArr(Rws, C + 1) = sArr(I, 34) chỉ hiểu mỗi thay dữ liệu để lấy cột mong muốn còn lại em mù tịt.

 

[tueyennhi]

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é.

ANh Ba tê ơi cho em hỏi thêm, sau khi đã tổng hợp dữ liệu rồi, em có file ngày nghỉ muốn update riêng vào cột WD của sheet BCC Anh xem file đính kèm giúp em nhé.


Em cảm ơn!

 

[tueyennhi]

Các anh ơi giúp em với

 

[tueyennhi]

Mọi người cho em hỏi chút em viết như vậy sai ở đâu mà không chạy

Option Explicit


Public Sub GPE()
Dim Dic As Object, Col As Object, Ws As Worksheet, Tem As String, Rws As Long
Dim sArr(), dArr(1 To 5000, 1 To 162), I As Long, J As Long, K As Long, C As Long
Set Dic = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
With Sheets("BCC")
sArr = .Range("B6").Resize(, 162).Value
For J = 1 To 162
If sArr(1, J) <> Empty Then
If IsDate(sArr(1, J)) Then Col.Item(Day(sArr(1, J))) = J
End If
Next J
End With
For Each Ws In Worksheets
If Ws.Name = "N" Then
C = Col.Item(Val(Ws.Name))
sArr = Ws.Range("C9", Ws.Range("C9").End(xlDown)).Resize(, 38).Value
For I = 1 To UBound(sArr)
Tem = sArr(I, 1)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(I, 1)
End If
Rws = Dic.Item(Tem)
dArr(Rws, C) = sArr(I, 33)
dArr(Rws, C + 1) = sArr(I, 34)
dArr(Rws, C + 2) = sArr(I, 35)
dArr(Rws, C + 3) = sArr(I, 36)
dArr(Rws, C + 4) = sArr(I, 38)
Next I
End If
Next Ws
Sheets("BCC").Range("B8").Resize(K, 162) = dArr
Set Dic = Nothing
Set Col = Nothing
End Sub

Code này của anh Ba tê, em sửa lại để up thêm thông tin từ sheet N, nhưng nó không chạy. Mục đích là update thêm giá trị nghỉ em cần ở sheet N. Em đã cố tìm hiểu về Scriptinh Dictionary nhưng vẫn chưa hiểu được để có thể thay đổi áp dụng cho đúng chứ không phải em y lại mọi người, mong mọi người giúp sức, công việc của em được 60% rồi! Mọi người xem ở file Update nhé, file kia em không gỡ được.

 

[befaint]

Mọi người cho em hỏi chút em viết như vậy sai ở đâu mà không chạy
...
Code này của anh Ba tê, em sửa lại để up thêm thông tin từ sheet N, nhưng nó không chạy. Mục đích là update thêm giá trị nghỉ em cần ở sheet N.

Góp ý với bạn tueyennhi,
Bạn nên để code/ công thức vào thẻ

 hoặc [PHP]

 

[tueyennhi]

Góp ý với bạn tueyennhi,
Bạn nên để code/ công thức vào thẻ

 hoặc [PHP][/QUOTE]

Cảm ơn bạn befaint, mình lại học được thêm một cái mới!

 

[tueyennhi]

Bài bị trôi, nhờ mọi người xem bài #76 giúp em nhé!

 

[sealand]

Bạn thử Code sau để xem dòng lệnh số 17 của bạn nó xác định vùng ở đâu (Chưa nói là câu lệnh này còn sai cú pháp Exc linh động cố chạy đấy):

Sub Test()
        Sheet2.Range("C9", Sheet2.Range("C9").End(xlDown)).Resize(, 38).Select
End Sub

Mình thấy câu lệnh

If Ws.Name <> "BCC" And Ws.Name = "N" Then

nó chỉ cần

 If Ws.Name = "N" Then

Bạn kiểm tra lại, vì mình không theo dõi từ đầu nên không biết bạn làm gì nên không kiểm tra hoạt động được