Giúp code tổng hợp (2 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 · 27/9/16

Nhờ code này của anh Lê Duy Thương

Sub add_acount()
Dim Dic, ws As Worksheet, iRow As Long, i As Long, Arr(), TmpArr, Tmp
On Error Resume Next
Application.ScreenUpdating = False
Sheet1.Range("a3:f5000").ClearContents
Set Dic = CreateObject("Scripting.Dictionary")
For Each ws In Worksheets
If ws.Name <> Sheet1 Then
TmpArr = ws.Range(ws.[a2], ws.[a5000].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 Sheet1
.Range("a3").Resize(i, 1) = WorksheetFunction.Transpose(Arr)
.Range("B3").FormulaR1C1 = _
"=SUMIF(INDIRECT(--RIGHT(R2C,2)&""!$A1:$A5000""),RC1,INDIRECT(--RIGHT(R2C,2)&""!$b1:$b5000""))"
.Range("B3").AutoFill Destination:=Range("B3:F3"), Type:=xlFillDefault
.Range("B3:F3").AutoFill Destination:=Range("B3:f" & [a5000].End(xlUp).Row)
.Range("B3:f" & [a5000].End(xlUp).Row).Value = Range("B3:f" & [a5000].End(xlUp).Row).Value

End With
Application.ScreenUpdating = True
End Sub

Em đã áp dụng vào file của mình được rồi. Cảm ơn anh nhiều!

befaint · 27/9/16

Chào tueyennhi,
Bạn tham khảo file đính kèm xem...

tueyennhi · 27/9/16

Chào anh Befaint, anh xem lại file của em xem nhé, Code của anh Lê Duy Thương em chưa áp dụng được triệt để, mới chỉ dừng ở mức lấy ID từ các sheet sao cho sheet tổng hợp ID đó là duy nhất, còn lại để áp giờ công của từng ngày vào sheet tổng hợp thì em chưa làm được. Ở mức vba cao như thế này em không có cơ bản nên em không hiểu code của anh cũng như của anh Thương. Dễ chút em còn có thể mò được chứ phức tạp như vậy khó quá, mong anh chỉ giúp em ạ.

befaint · 27/9/16

tueyennhi đã viết:
Chào anh Befaint, anh xem lại file của em xem nhé, Code của anh Lê Duy Thương em chưa áp dụng được triệt để, mới chỉ dừng ở mức lấy ID từ các sheet sao cho sheet tổng hợp ID đó là duy nhất, còn lại để áp giờ công của từng ngày vào sheet tổng hợp thì em chưa làm được. Ở mức vba cao như thế này em không có cơ bản nên em không hiểu code của anh cũng như của anh Thương. Dễ chút em còn có thể mò được chứ phức tạp như vậy khó quá, mong anh chỉ giúp em ạ.

Bạn nói vậy làm tôi tự thấy xí hổ... $:=\+$
Cái đó là của anh ndu96081631

PHP:

Function UniqueArray(SrcRng As Range) 'ndu96081631 -GPE
  Dim Src, tmp As String, arr()
  Dim i As Long, j As Long, n As Long
  Src = SrcRng.Value
  ReDim arr(1 To UBound(Src, 1), 1 To UBound(Src, 2))
  With CreateObject("Scripting.Dictionary")
    For i = LBound(Src, 1) To UBound(Src, 1)
      tmp = ""
      For j = LBound(Src, 2) To UBound(Src, 2)
        tmp = tmp & Src(i, j)
      Next
      If tmp <> "" Then
        If Not .Exists(tmp) Then
          n = n + 1
          .Add tmp, ""
          For j = LBound(Src, 2) To UBound(Src, 2)
            arr(n, j) = Src(i, j)
          Next
        End If
      End If
    Next
  End With
  If j <> 0 Then
    UniqueArray = arr
  End If
End Function

Tôi chỉ làm động tác copy dữ liệu từ các sheets vào sheet "Tong hop".

PHP:

Sub TongHop()
Dim lr As Long, rw As Long, i As Long, tmp
Sheet1.Range("A4:C65000").ClearContents
For i = 2 To Worksheets.Count
    lr = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
    rw = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
    tmp = Sheets(i).Range("A3:C" & lr).Value
    Sheets(1).Cells(rw + 1, 1).Resize(UBound(tmp), 3) = tmp
Next
rw = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
tmp = UniqueArray(Sheets(1).Range("A4:C" & rw))
Sheets(1).Range("A4").Resize(UBound(tmp), 3) = tmp
End Sub

p/s: Nếu tổng ID ở các sheets > số dòng của bảng tính thì phải chạy UniqueArray trước khi gán xuống sheet "Tong hop".
Chúc bạn một ngày vui!

tueyennhi · 27/9/16

Anh ơi code này nó gộp tất cả giờ vào một cột thôi. Em muốn giờ công của ngày nào sẽ vào cột của ngày tương ứng. Anh xem lại cho em nhé. Em có thấy trong code trích dẫn của thầy ndu, nhưng để viết được thêm đoạn của anh đối với em là cả hành trình rất dài rồi anh ạ

befaint · 27/9/16

tueyennhi đã viết:
Anh ơi code này nó gộp tất cả giờ vào một cột thôi. Em muốn giờ công của ngày nào sẽ vào cột của ngày tương ứng. Anh xem lại cho em nhé. (

Ờ ha. Tại chỉ để ý tới yêu cầu lấy ID của bạn, cái vụ tổng hợp giờ công thì để nghĩ đã...

tueyennhi · 27/9/16

Vâng anh xem lại giúp em, cái này chắc phức tạp hơn nhiều !$@!!

SA_DQ · 27/9/16

Anh ơi code này nó . . .

Bạn xài macro thô sơ này thử:

PHP:

Option Explicit
Sub THCC()
Dim Dic1 As Object, Arr() As Variant, TmpArr As Variant, Sh As Worksheet
Dim Rws As Long, J As Long, W As Long, Col As Byte
Dim SN As String
With Sheets("Tong Hop")
  .Range("b4").CurrentRegion.Offset(1).ClearContents
  Set Dic1 = CreateObject("Scripting.Dictionary")
  ReDim Arr(1 To 9999, 1 To 9)
  For Each Sh In ThisWorkbook.Worksheets
    SN = Sh.Name
    If IsNumeric(SN) Then
        For J = 3 To Sh.[a3].End(xlDown).Row
            If Sh.Cells(J, "A").Value = "" Then Exit For
            Col = CByte(SN) * 2
            If Not Dic1.exists(Sh.Cells(J, "A").Value) Then
                W = W + 1
                Arr(W, 1) = Sh.Cells(J, "A").Value
                Dic1.Add Sh.Cells(J, "A").Value, W
                Arr(W, Col) = Sh.Cells(J, "B").Value
                Arr(W, 1 + Col) = Sh.Cells(J, "C").Value
            Else
                Arr(Dic1.Item(Sh.Cells(J, "A").Value), Col) = Sh.Cells(J, "B").Value
                Arr(Dic1.Item(Sh.Cells(J, "A").Value), 1 + Col) = Sh.Cells(J, "C").Value
            End If
        Next J
    End If
  Next Sh
  If W Then
    .[A4].Resize(W, 9).Value = Arr()
  End If
 End With
End Sub

Nếu nhiều người trong CQ sẽ fải tìm cách tăng tốc sau!

tueyennhi · 27/9/16

HYen17 đã viết:

Bạn xài macro thô sơ này thử:

PHP:

Option Explicit
Sub THCC()
Dim Dic1 As Object, Arr() As Variant, TmpArr As Variant, Sh As Worksheet
Dim Rws As Long, J As Long, W As Long, Col As Byte
Dim SN As String
With Sheets("Tong Hop")
  .Range("b4").CurrentRegion.Offset(1).ClearContents
  Set Dic1 = CreateObject("Scripting.Dictionary")
  ReDim Arr(1 To 9999, 1 To 9)
  For Each Sh In ThisWorkbook.Worksheets
    SN = Sh.Name
    If IsNumeric(SN) Then
        For J = 3 To Sh.[a3].End(xlDown).Row
            If Sh.Cells(J, "A").Value = "" Then Exit For
            Col = CByte(SN) * 2
            If Not Dic1.exists(Sh.Cells(J, "A").Value) Then
                W = W + 1
                Arr(W, 1) = Sh.Cells(J, "A").Value
                Dic1.Add Sh.Cells(J, "A").Value, W
                Arr(W, Col) = Sh.Cells(J, "B").Value
                Arr(W, 1 + Col) = Sh.Cells(J, "C").Value
            Else
                Arr(Dic1.Item(Sh.Cells(J, "A").Value), Col) = Sh.Cells(J, "B").Value
                Arr(Dic1.Item(Sh.Cells(J, "A").Value), 1 + Col) = Sh.Cells(J, "C").Value
            End If
        Next J
    End If
  Next Sh
  If W Then
    .[A4].Resize(W, 9).Value = Arr()
  End If
 End With
End Sub

Nếu nhiều người trong CQ sẽ fải tìm cách tăng tốc sau!

Chào anh, file của em chỉ là file mẫu thôi, thực tế em làm bảng chấm công tổng hợp trong một tháng, mỗi sheet là một ngày công. Ý định của em là qua form mẫu để áp dụng vào form thực tế, nhưng thú thực mọi người em không hiểu để có thể áp dụng vào file thực tế, vì vậy em up lại file em đang phải làm anh xem lại giúp em nhé.
Em chỉ cho 2 sheet ngày công ví dụ, thực tế thì chu kỳ lương sẽ là từ 26 tháng trước đến 25 tháng này (mỗi ngày là một sheet).

befaint · 27/9/16

Tạm như vầy, sai ráng sửa --=0

Sub:

PHP:

Sub TongHop()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim lr As Long, rw As Long, i As Long, cl As Long
Dim tmp, ID
Sheet1.Range("A4:ZZ65000").ClearContents
For i = 2 To Worksheets.Count
    lr = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
    rw = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
    tmp = Sheets(i).Range("A3:A" & lr).Value
    Sheets(1).Cells(rw + 1, 1).Resize(UBound(tmp)) = tmp
Next
rw = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
tmp = UniqueArray(Sheets(1).Range("A4:A" & rw))
Sheets(1).Range("A4").Resize(UBound(tmp)) = tmp
rw = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To Worksheets.Count
    lr = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
    tmp = Sheets(i).Range("A3:C" & lr).Value
    On Error Resume Next
    For j = 1 To UBound(tmp)
        ID = WorksheetFunction.Match(tmp(j, 1), Sheets(1).Range("A1:A" & rw), 0)
        cl = Sheet1.Cells(ID, Columns.Count).End(xlToLeft).Column
        Sheet1.Cells(ID, cl + 1) = tmp(j, 2)
        Sheet1.Cells(ID, cl + 2) = tmp(j, 3)
    Next j
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Function UniqueArray thì bạn chép lại như bài trước.

tueyennhi · 27/9/16

Anh xem lại bài #10 giúp em nhé **~**

befaint · 27/9/16

tueyennhi đã viết:
Anh xem lại bài #10 giúp em nhé

Ờ. Xem rồi.
Bạn có biết bài #10 và bài #1 là khác nhau như nào không? Sao cái file ở bài #10 không được đính kèm ở bài #1 ta?

tueyennhi · 27/9/16

befaint đã viết:
Ờ. Xem rồi.
Bạn có biết bài #10 và bài #1 là khác nhau như nào không? Sao cái file ở bài #10 không được đính kèm ở bài #1 ta?

Ngoài việc phục vụ cho công việc em cũng muốn tự mình tìm hiểu vận dụng. Nhưng lần này quá sức của em anh ạ -+*/

ChanhTQ@ · 27/9/16

Bạn kiểm số liệu theo file; . . . Có gì thì chỉnh tiếp

tueyennhi · 27/9/16

ChanhTQ@ đã viết:
Bạn kiểm số liệu theo file; . . . Có gì thì chỉnh tiếp

Vâng để em mò có gì không hiểu em sẽ hỏi, cảm ơn anh !

tueyennhi · 27/9/16

ChanhTQ@ đã viết:
Bạn kiểm số liệu theo file; . . . Có gì thì chỉnh tiếp

File này mình phải lọc dữ liệu ID trước sau đó copy vào sheet bcc đúng không anh? Em xóa hết dữ liệu trong bcc chạy thử thì đơ luôn anh ạ. Còn lại nếu có ID rồi thì file này quả thật là quá tuyệt, chạy nhanh quá sức tưởng tượng anh ạ }}}}}

Lê Duy Thương · 27/9/16

tueyennhi đã viết:
Chào anh Befaint, anh xem lại file của em xem nhé, Code của anh Lê Duy Thương em chưa áp dụng được triệt để, mới chỉ dừng ở mức lấy ID từ các sheet sao cho sheet tổng hợp ID đó là duy nhất, còn lại để áp giờ công của từng ngày vào sheet tổng hợp thì em chưa làm được. Ở mức vba cao như thế này em không có cơ bản nên em không hiểu code của anh cũng như của anh Thương. Dễ chút em còn có thể mò được chứ phức tạp như vậy khó quá, mong anh chỉ giúp em ạ.

bạn đã hỏi và được trả lời ở đây
http://www.giaiphapexcel.com/forum/...nhiều-sheet-vào-một-sheet&p=745478#post745478

tueyennhi · 27/9/16

Lê Duy Thương đã viết:
bạn đã hỏi và được trả lời ở đây
http://www.giaiphapexcel.com/forum/...nhiều-sheet-vào-một-sheet&p=745478#post745478

Em có up file thực tế vào rồi vì code của anh em không hiểu để áp dụng vào file của em được.

tueyennhi · 27/9/16

ChanhTQ@ đã viết:
Bạn kiểm số liệu theo file; . . . Có gì thì chỉnh tiếp

Anh ơi có một chút vấn đề là khi em chạy vào file thực tế thì báo lỗi. File của anh up lên em thử copy nhân bản thêm 10 sheet nữa thì cũng chạy báo lỗi anh ạ.
For J = 1 To UBound(Arr())

Ngoài sheet BCC thì trong file của em còn các sheet từ 26 đến 31 và 1 đến 25.

Giúp code tổng hợp (2 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

|||||||||||||

File đính kèm

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

File đính kèm

|||||||||||||

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

|||||||||||||

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

/(hông là gì!

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

File đính kèm

|||||||||||||

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

|||||||||||||

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

0901452không62

File đính kèm

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

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

Cạo lấy gì gội (Dịch quá không gội được)

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

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

Đếm ngược thời gian