Nhờ thầy, cô, anh, chị giúp code lấy 1 mã dữ liệu từ các sheets và cộng gộp lại.

hoangminh2018 · 27/5/19

Em có file này nhờ thầy, cô, anh, chị viết code giúp
Trong nhiều sheet có thể có tên và mã trùng trong sheet, có thể tên và mã trung nhau giữa các sheets.
sheets (BangTH) đầ tiên là không có gì sau khi viết code ra thì chỉ lấy tên nv 1 lần thôi rồi thì cộng giá trị lại.
Em xin cảm ơn ạ.

SA_DQ · 27/5/19

Trùng mã NV nhưng luong & doang thu không trùng; Vậy cho hỏi bạn thì lấy lương & Doanh Thu tối thiểu hay tối đa?
Hay lấy tùy hứng

hoangminh2018 · 27/5/19

SA_DQ đã viết:
Trùng mã NV nhưng luong & doang thu không trùng; Vậy cho hỏi bạn thì lấy lương & Doanh Thu tối thiểu hay tối đa?
Hay lấy tùy hứng

Dạ lương và doanh thu thì cộng hêt lại ạ.

SA_DQ · 27/5/19

Vậy thì đây:

PHP:

Sub TongHopLuongTheoCacCaNhan()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Dim Rws As Long, Lg As Double, DThu As Double
 Dim MyAdd As String
 
 Sheets("BangTH").Select
 For Each Cls In Range([c7], [c7].End(xlDown))
    Cls.Offset(, 2).Resize(, 2).ClearContents
    For Each Sh In ThisWorkbook.Worksheets
        If Left(Sh.Name, 2) = "DS" Then
            Rws = Sh.[c4].CurrentRegion.Rows.Count
            Set Rng = Sh.[c4].Resize(Rws)
            Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
            If Not sRng Is Nothing Then
                MyAdd = sRng.Address
                Do
                    Lg = Lg + sRng.Offset(, 2).Value:       DThu = DThu + sRng.Offset(, 3).Value
                    Set sRng = Rng.FindNext(sRng)
                Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
            End If
        End If
        If Lg Then
            Cls.Offset(, 2).Value = Lg + Cls.Offset(, 2).Value
            Cls.Offset(, 3).Value = DThu + Cls.Offset(, 3)
            Lg = 0:                                                     DThu = 0
        End If
    Next Sh
 Next Cls
End Sub

hoangminh2018 · 27/5/19

SA_DQ đã viết:

Vậy thì đây:

PHP:

Sub TongHopLuongTheoCacCaNhan()
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
Dim Rws As Long, Lg As Double, DThu As Double
Dim MyAdd As String

Sheets("BangTH").Select
For Each Cls In Range([c7], [c7].End(xlDown))
    Cls.Offset(, 2).Resize(, 2).ClearContents
    For Each Sh In ThisWorkbook.Worksheets
        If Left(Sh.Name, 2) = "DS" Then
            Rws = Sh.[c4].CurrentRegion.Rows.Count
            Set Rng = Sh.[c4].Resize(Rws)
            Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
            If Not sRng Is Nothing Then
                MyAdd = sRng.Address
                Do
                    Lg = Lg + sRng.Offset(, 2).Value:       DThu = DThu + sRng.Offset(, 3).Value
                    Set sRng = Rng.FindNext(sRng)
                Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
            End If
        End If
        If Lg Then
            Cls.Offset(, 2).Value = Lg + Cls.Offset(, 2).Value
            Cls.Offset(, 3).Value = DThu + Cls.Offset(, 3)
            Lg = 0:                                                     DThu = 0
        End If
    Next Sh
Next Cls
End Sub

Dạ em cảm ơn, nhưng em đã test thử thì nó bị lỗi chạy hoài à, cứ xoay vòng tròn hoài, không ra kết quả mà cũng không báo lỗi luôn.

SA_DQ · 27/5/19

. . . . . . . . . . . . . . .

Nguyễn Hồng Quang · 27/5/19

Bài đã được tự động gộp: 27/5/19

SA_DQ đã viết:

Vậy thì đây:

PHP:

Sub TongHopLuongTheoCacCaNhan()
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
Dim Rws As Long, Lg As Double, DThu As Double
Dim MyAdd As String

Sheets("BangTH").Select
For Each Cls In Range([c7], [c7].End(xlDown))
    Cls.Offset(, 2).Resize(, 2).ClearContents
    For Each Sh In ThisWorkbook.Worksheets
        If Left(Sh.Name, 2) = "DS" Then
            Rws = Sh.[c4].CurrentRegion.Rows.Count
            Set Rng = Sh.[c4].Resize(Rws)
            Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
            If Not sRng Is Nothing Then
                MyAdd = sRng.Address
                Do
                    Lg = Lg + sRng.Offset(, 2).Value:       DThu = DThu + sRng.Offset(, 3).Value
                    Set sRng = Rng.FindNext(sRng)
                Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
            End If
        End If
        If Lg Then
            Cls.Offset(, 2).Value = Lg + Cls.Offset(, 2).Value
            Cls.Offset(, 3).Value = DThu + Cls.Offset(, 3)
            Lg = 0:                                                     DThu = 0
        End If
    Next Sh
Next Cls
End Sub

Em mượn đoạn code của anh SA_DQ ở #4 này để làm bài này nhé

hoangminh2018 đã viết:
Dạ em cảm ơn, nhưng em đã test thử thì nó bị lỗi chạy hoài à, cứ xoay vòng tròn hoài, không ra kết quả mà cũng không báo lỗi luôn.

Bạn xem thử file này

hoangminh2018 · 27/5/19

SA_DQ đã viết:
. . . . . . . . . . . . . . .

Dạ thầy ơi ý em là sheet tổng hợp chỉ có dàng tiêu đề thôi, từ dòng 7 trở xuống thì khi chạy code tự ra luôn ạ, xin lỗi thầy vì em diễn đạt không rõ nghĩa ạ.

Bài đã được tự động gộp: 27/5/19

Nguyễn Hồng Quang đã viết:
Bài đã được tự động gộp: 27/5/19

Em mượn đoạn code của anh SA_DQ ở #4 này để làm bài này nhé

Bạn xem thử file này

Dạ code của anh chạy ra gần đúng ý ạ, chỉ có cột tên NV thì khi chạy code không ra ạ, anh có thể chỉnh lại giúp em được không ạ.

Nguyễn Hồng Quang · 27/5/19

hoangminh2018 đã viết:
Dạ code của anh chạy ra gần đúng ý ạ, chỉ có cột tên NV thì khi chạy code không ra ạ, anh có thể chỉnh lại giúp em được không ạ.

Thì trong file gốc của bạn nêu là lấy và loại trùng mã NV. Cái tên thì bạn dùng hàm tra cứu cũng ra mà. Nhìn file của bạn mình đoán là bạn dấu sheet danh sách nhân viên đi rồi phải không

SA_DQ · 28/5/19

Dạ thầy ơi ý em là sheet tổng hợp chỉ có dàng tiêu đề thôi, từ dòng 7 trở xuống thì khi chạy code tự ra luôn ạ, xin lỗi thầy vì em diễn đạt không rõ nghĩa ạ..

Nếu vậy thì bạn chép hết danh sách nhân viên (gồm cả mã) từ các trang 'DS' sang trang tổng hợp
Sau đó lập danh sách duy nhất tại 2 cột này.

Thực hiện các bước này nhiều lần trở thành như trở bàn tay;
Sau đó mở bộ thu Macro lên & thu lại các thao tác.

Còn nếu bạn biết Dictionary thì dễ hơn chút đĩnh & tự làm đi, cách nào cũng được!

/(ể cũng lạ: CQ gì mà không có lấy danh sách nhân viên là sao?

hoangminh2018 · 28/5/19

Nguyễn Hồng Quang đã viết:
Thì trong file gốc của bạn nêu là lấy và loại trùng mã NV. Cái tên thì bạn dùng hàm tra cứu cũng ra mà. Nhìn file của bạn mình đoán là bạn dấu sheet danh sách nhân viên đi rồi phải không

Dạ vì công ty em nv ra vào liên tục, mỗi tháng là có nv cũ nghỉ, nv mới vào nên danh sách nv loạn hết ạ, em cảm ơn anh đã giúp em.

Bài đã được tự động gộp: 28/5/19

SA_DQ đã viết:
Nếu vậy thì bạn chép hết danh sách nhân viên (gồm cả mã) từ các trang 'DS' sang trang tổng hợp
Sau đó lập danh sách duy nhất tại 2 cột này.

Thực hiện các bước này nhiều lần trở thành như trở bàn tay;
Sau đó mở bộ thu Macro lên & thu lại các thao tác.

Còn nếu bạn biết Dictionary thì dễ hơn chút đĩnh & tự làm đi, cách nào cũng được!

/(ể cũng lạ: CQ gì mà không có lấy danh sách nhân viên là sao?

Dạ công ty em mỗi tháng đêu có nv cũ nghỉ, nv mới vào làm nên em hơi bị rối ạ, em không biết về dictionary, em cảm ơn thầy đã dành thời gian cho em ạ.

snow25 · 28/5/19

hoangminh2018 đã viết:
Em có file này nhờ thầy, cô, anh, chị viết code giúp
Trong nhiều sheet có thể có tên và mã trùng trong sheet, có thể tên và mã trung nhau giữa các sheets.
sheets (BangTH) đầ tiên là không có gì sau khi viết code ra thì chỉ lấy tên nv 1 lần thôi rồi thì cộng giá trị lại.
Em xin cảm ơn ạ.

Bạn chạy thử code này.Nhưng khác kết quả của ban.

Mã:

Sub linhtinh()
    Dim arr, arr1, dic As Object, lr As Long, i As Long, dk As String, a As Long, b As Long, max As Long, sh As Worksheet
    Set dic = CreateObject("scripting.dictionary")
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "BangTH" Then
           lr = sh.Range("C" & Rows.Count).End(xlUp).Row
           max = max + lr
        End If
    Next
    ReDim arr1(1 To max, 1 To 5)
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "BangTH" Then
           lr = sh.Range("C" & Rows.Count).End(xlUp).Row
           If lr > 4 Then
              arr = sh.Range("C5:F" & lr).Value
              For i = 1 To UBound(arr, 1)
                  dk = UCase(arr(i, 1))
                  If Not dic.exists(dk) Then
                     a = a + 1
                     dic.Add dk, a
                     arr1(a, 1) = a
                     arr1(a, 2) = arr(i, 1)
                     arr1(a, 3) = arr(i, 2)
                     arr1(a, 4) = arr(i, 3)
                     arr1(a, 5) = arr(i, 4)
                  Else
                     b = dic.Item(dk)
                     arr1(b, 4) = arr1(b, 4) + arr(i, 3)
                     arr1(b, 5) = arr1(b, 5) + arr(i, 4)
                  End If
             Next i
           End If
        End If
   Next
   With Sheets("bangth")
        lr = .Range("C" & Rows.Count).End(xlUp).Row
        If lr > 6 Then .Range("B7:F" & lr).ClearContents
        If a Then .Range("b7:F7").Resize(a).Value = arr1
   End With
End Sub

hoangminh2018 · 28/5/19

snow25 đã viết:

Bạn chạy thử code này.Nhưng khác kết quả của ban.

Mã:

Sub linhtinh()
    Dim arr, arr1, dic As Object, lr As Long, i As Long, dk As String, a As Long, b As Long, max As Long, sh As Worksheet
    Set dic = CreateObject("scripting.dictionary")
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "BangTH" Then
           lr = sh.Range("C" & Rows.Count).End(xlUp).Row
           max = max + lr
        End If
    Next
    ReDim arr1(1 To max, 1 To 5)
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "BangTH" Then
           lr = sh.Range("C" & Rows.Count).End(xlUp).Row
           If lr > 4 Then
              arr = sh.Range("C5:F" & lr).Value
              For i = 1 To UBound(arr, 1)
                  dk = UCase(arr(i, 1))
                  If Not dic.exists(dk) Then
                     a = a + 1
                     dic.Add dk, a
                     arr1(a, 1) = a
                     arr1(a, 2) = arr(i, 1)
                     arr1(a, 3) = arr(i, 2)
                     arr1(a, 4) = arr(i, 3)
                     arr1(a, 5) = arr(i, 4)
                  Else
                     b = dic.Item(dk)
                     arr1(b, 4) = arr1(b, 4) + arr(i, 3)
                     arr1(b, 5) = arr1(b, 5) + arr(i, 4)
                  End If
             Next i
           End If
        End If
   Next
   With Sheets("bangth")
        lr = .Range("C" & Rows.Count).End(xlUp).Row
        If lr > 6 Then .Range("B7:F" & lr).ClearContents
        If a Then .Range("b7:F7").Resize(a).Value = arr1
   End With
End Sub

Dạ em cảm ơn anh, kết quả ra đúng như mong đợi của em luôn ạ.

Nguyễn Hồng Quang · 28/5/19

hoangminh2018 đã viết:
Dạ vì công ty em nv ra vào liên tục, mỗi tháng là có nv cũ nghỉ, nv mới vào nên danh sách nv loạn hết ạ, em cảm ơn anh đã giúp em.

Lý do bạn nêu ra nghe không thực tế cho lắm; vì đã có mã nhân viên rồi thì thường là phải có danh sách.
Mình gửi bạn file làm nốt với tên nhân viên
Nếu bạn chưa có thì Tốt nhất bạn nên xây dựng danh sách nhân viên tránh việc nhập đúng mã nhưng sai tên

Bài đã được tự động gộp: 28/5/19

snow25 đã viết:

Bạn chạy thử code này.Nhưng khác kết quả của ban.

Mã:

Sub linhtinh()
    Dim arr, arr1, dic As Object, lr As Long, i As Long, dk As String, a As Long, b As Long, max As Long, sh As Worksheet
    Set dic = CreateObject("scripting.dictionary")
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "BangTH" Then
           lr = sh.Range("C" & Rows.Count).End(xlUp).Row
           max = max + lr
        End If
    Next
    ReDim arr1(1 To max, 1 To 5)
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "BangTH" Then
           lr = sh.Range("C" & Rows.Count).End(xlUp).Row
           If lr > 4 Then
              arr = sh.Range("C5:F" & lr).Value
              For i = 1 To UBound(arr, 1)
                  dk = UCase(arr(i, 1))
                  If Not dic.exists(dk) Then
                     a = a + 1
                     dic.Add dk, a
                     arr1(a, 1) = a
                     arr1(a, 2) = arr(i, 1)
                     arr1(a, 3) = arr(i, 2)
                     arr1(a, 4) = arr(i, 3)
                     arr1(a, 5) = arr(i, 4)
                  Else
                     b = dic.Item(dk)
                     arr1(b, 4) = arr1(b, 4) + arr(i, 3)
                     arr1(b, 5) = arr1(b, 5) + arr(i, 4)
                  End If
             Next i
           End If
        End If
   Next
   With Sheets("bangth")
        lr = .Range("C" & Rows.Count).End(xlUp).Row
        If lr > 6 Then .Range("B7:F" & lr).ClearContents
        If a Then .Range("b7:F7").Resize(a).Value = arr1
   End With
End Sub

Cảm ơn snow. Code của bạn tuyệt thật.

hoangminh2018 · 28/5/19

Nguyễn Hồng Quang đã viết:
Lý do bạn nêu ra nghe không thực tế cho lắm; vì đã có mã nhân viên rồi thì thường là phải có danh sách.
Mình gửi bạn file làm nốt với tên nhân viên
Nếu bạn chưa có thì Tốt nhất bạn nên xây dựng danh sách nhân viên tránh việc nhập đúng mã nhưng sai tên

Bài đã được tự động gộp: 28/5/19

Cảm ơn snow. Code của bạn tuyệt thật.

Dạ em cảm ơn anh.

Nhờ thầy, cô, anh, chị giúp code lấy 1 mã dữ liệu từ các sheets và cộng gộp lại.

Thành viên chính thức

File đính kèm

/(hông là gì!

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

File đính kèm

/(hông là gì!

File đính kèm

Thành viên GPE Hà Nội

File đính kèm

Thành viên chính thức

Thành viên GPE Hà Nội

/(hông là gì!

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Thành viên GPE Hà Nội

File đính kèm

Thành viên chính thức

Facebook

Group