Sửa code để tổng hợp dữ liệu liên tiếp (1 người xem)

[khoa289]

Chào mọi người trong diễn đàn giaiphapexcel.
Giúp mình sửa lại code để:
Làm sao để tổng hợp dữ liệu như sheet TONG HOP nhưng không có các số 0 (khi tổng hợp sẽ không có số 0 ở sheet TONG HOP, dữ liệu sau khi Bấm nút "RUN" dữ liệu là liên tiếp, có liên kết với các sheet khác như sheet "TONG HOP-KQ mong muon nhu file)
Cám ơn.
Đính kèm file
PS: Kết quả cần là sheet "TONG HOP" không có số 0 và dữ liệu ở sheet "TONG HOP" là liên tiếp nhau có liên kết với các sheet khác.

 

[PacificPR]

Chào mọi người trong diễn đàn giaiphapexcel.
Giúp mình sửa lại code để:
Làm sao để tổng hợp dữ liệu như sheet TONG HOP nhưng không có các số 0 (khi tổng hợp sẽ không có số 0 ở sheet TONG HOP, dữ liệu sau khi Bấm nút "RUN" dữ liệu là liên tiếp, có liên kết với các sheet khác như sheet "TONG HOP-KQ mong muon nhu file)
Cám ơn.
Đính kèm file
PS: Kết quả cần là sheet "TONG HOP" không có số 0 và dữ liệu ở sheet "TONG HOP" là liên tiếp nhau có liên kết với các sheet khác.

Bạn thử dùng cái này thử:

Sub Tonghop()

    Dim Ws As Worksheet, Master As Worksheet   
    Dim Ep As Long, Ec As Long, I As Long, K As Long
Set Master = Sheets("TONG HOP")
Master.Range("A2:B" & Master.Range("A65535").End(3).Row).ClearContents
For Each Ws In Worksheets
    If Ws.Name Like "DU LIEU*" Then
        Ec = Ws.Range("A65535").End(3).Row
        Ep = Master.Range("A65535").End(3).Row
        K = Ep
        For I = 2 To Ec
            K = K + 1
            Master.Cells(K, 1).Formula = "=" & "'" & Ws.Name & "'!" & Ws.Cells(I, 1).Address
            Master.Cells(K, 2).Formula = "=" & "'" & Ws.Name & "'!" & Ws.Cells(I, 2).Address
        Next I
    End If
Next
End Sub

 

[phulien1902]

Chào mọi người trong diễn đàn giaiphapexcel.
Giúp mình sửa lại code để:
Làm sao để tổng hợp dữ liệu như sheet TONG HOP nhưng không có các số 0 (khi tổng hợp sẽ không có số 0 ở sheet TONG HOP, dữ liệu sau khi Bấm nút "RUN" dữ liệu là liên tiếp, có liên kết với các sheet khác như sheet "TONG HOP-KQ mong muon nhu file)
Cám ơn.
Đính kèm file
PS: Kết quả cần là sheet "TONG HOP" không có số 0 và dữ liệu ở sheet "TONG HOP" là liên tiếp nhau có liên kết với các sheet khác.

Bạn thử với:

Sub abc()
    Dim ws, Sh As Worksheet
    Set Sh = Sheets("TONG HOP")
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "TONG HOP" And ws.Name <> "TONG HOP-KQ mong muon nhu file" Then
            ws.Range("A2:B100").Copy Sh.Range("A" & Rows.Count).End(3)(2)
        End If
    Next
End Sub

 

[HieuCD]

Bạn thử dùng cái này thử:

Sub Tonghop()

    Dim Ws As Worksheet, Master As Worksheet  
    Dim Ep As Long, Ec As Long, I As Long, K As Long
Set Master = Sheets("TONG HOP")
Master.Range("A2:B" & Master.Range("A65535").End(3).Row).ClearContents
For Each Ws In Worksheets
    If Ws.Name Like "DU LIEU*" Then
        Ec = Ws.Range("A65535").End(3).Row
        Ep = Master.Range("A65535").End(3).Row
        K = Ep
        For I = 2 To Ec
            K = K + 1
            Master.Cells(K, 1).Formula = "=" & "'" & Ws.Name & "'!" & Ws.Cells(I, 1).Address
            Master.Cells(K, 2).Formula = "=" & "'" & Ws.Name & "'!" & Ws.Cells(I, 2).Address
        Next I
    End If
Next
End Sub

bạn thử với dòng lệnh

Master.Cells(Ep, 1).Resize(Ec - 1, 2).Formula = "=" & "'" & Ws.Name & "'!" & "R[" & 2 - Ep & "]C"

 

[PacificPR]

bạn thử với dòng lệnh

Master.Cells(Ep, 1).Resize(Ec - 1, 2).Formula = "=" & "'" & Ws.Name & "'!" & "R[" & 2 - Ep & "]C"

Cái này hay quá anh ạ. Bỏ được vòng For tốc độ nhanh hơn nhiều

 

[khoa289]

Cám ơn mọi người đã giúp đỡ.
Trường hợp mình cần so sánh dữ liệu ở sheet TONG HOP thì mình cần chuyển sang dữ liệu ngang như file Đính kèm. Mọi người giúp đỡ trường hợp này cho mình với. Cám ơn nhiều
PS: Vì tổng hợp dọc bất tiện là không so sánh được.

 

[phulien1902]

Cám ơn mọi người đã giúp đỡ.
Trường hợp mình cần so sánh dữ liệu ở sheet TONG HOP thì mình cần chuyển sang dữ liệu ngang như file Đính kèm. Mọi người giúp đỡ trường hợp này cho mình với. Cám ơn nhiều
PS: Vì tổng hợp dọc bất tiện là không so sánh được.

Bạn thử:

Sub abc_New()
    Dim ws, Sh As Worksheet
    Set Sh = Sheets("TONG HOP")
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "TONG HOP" And ws.Name <> "TONG HOP-KQ mong muon nhu file" Then
            ws.Range("A2:B100").Copy Sh.Cells(2, Sh.Columns.Count).End(xlToLeft).Offset(, 1)
            End If
    Next
End Sub

 

[khoa289]

Cám ơn bạn phulien1902 nhưng code bạn chưa đúng ý mình lắm vì:
1. Chưa có liên kết giữa sheet tổng hợp với các sheet chi tiết (Có liên kết nhằm mục đích kiểm tra và tìm đến sheet chi tiết nhanh hơn nếu có nhiều dòng).
2. Khi kích (Run) chạy lần 2 thì dữ liệu tiếp tục copy sang phải (Như vậy là không cần thiết vì dữ liệu trùng lại với dữ liệu cũ)
Có thể sửa lại code khác được không bạn ???

 

[PacificPR]

Cám ơn bạn phulien1902 nhưng code bạn chưa đúng ý mình lắm vì:
1. Chưa có liên kết giữa sheet tổng hợp với các sheet chi tiết (Có liên kết nhằm mục đích kiểm tra và tìm đến sheet chi tiết nhanh hơn nếu có nhiều dòng).
2. Khi kích (Run) chạy lần 2 thì dữ liệu tiếp tục copy sang phải (Như vậy là không cần thiết vì dữ liệu trùng lại với dữ liệu cũ)
Có thể sửa lại code khác được không bạn ???

Mình chưa áp dụng được cách của anh HieuCD. vẫn phải sử dụng For next

Sub thonghopkhoa()
    Dim Ws As Worksheet, Master As Worksheet
    Dim Ec As Long, Col As Long, I As Long
Set Master = Sheets("TONG HOP")
Master.Range("A2:IV65535").ClearContents
Col = 1
For Each Ws In Worksheets
    If Ws.Name Like "DU LIEU*" Then
        Ec = Ws.Range("A65535").End(3).Row
        For I = 1 To Ec
            Master.Cells(I, Col).Formula = "=" & "'" & Ws.Name & "'!" & Ws.Cells(I, 1).Address
            Master.Cells(I, Col + 1).Formula = "=" & "'" & Ws.Name & "'!" & Ws.Cells(I, 2).Address
        Next I
        Col = Col + 2
    End If
Next
End Sub

 

[HieuCD]

Mình chưa áp dụng được cách của anh HieuCD. vẫn phải sử dụng For next

Sub thonghopkhoa()
    Dim Ws As Worksheet, Master As Worksheet
    Dim Ec As Long, Col As Long, I As Long
Set Master = Sheets("TONG HOP")
Master.Range("A2:IV65535").ClearContents
Col = 1
For Each Ws In Worksheets
    If Ws.Name Like "DU LIEU*" Then
        Ec = Ws.Range("A65535").End(3).Row
        For I = 1 To Ec
            Master.Cells(I, Col).Formula = "=" & "'" & Ws.Name & "'!" & Ws.Cells(I, 1).Address
            Master.Cells(I, Col + 1).Formula = "=" & "'" & Ws.Name & "'!" & Ws.Cells(I, 2).Address
        Next I
        Col = Col + 2
    End If
Next
End Sub

bạn tính lại col dùng hàm replace loại "DULIEU", nhiều khi duyệt sheet dulieu2, dulieu3 rồi mới tới dulieu1 thì vị trí gán giá trị không đúng

    col = ....
    Master.Cells(3, col).Resize(Ec - 2, 2).Formula = "=" & "'" & Ws.Name & "'!RC[" & 1 - col & "]"

 

[MeThuongNho]

Dear phulien1902, HieuCD,
Vậy file của em: file KHSX (sheet TONGHOP) , còn sheet TONGHOP-KQ thì nằm file DHKD (sheet THDH).
Thì code sao ah.
Mong mọi người chỉ giúp, ứng dụng mình đang rất cần,
Cám ơn mọi người nhiều!

 

[HieuCD]

Dear phulien1902, HieuCD,
Vậy file của em: file KHSX (sheet TONGHOP) , còn sheet TONGHOP-KQ thì nằm file DHKD (sheet THDH).
Thì code sao ah.
Mong mọi người chỉ giúp, ứng dụng mình đang rất cần,
Cám ơn mọi người nhiều!

lập topic mới và gởi file với yêu cầu và ví dụ, kết quả cụ thể mới làm được

 

[MeThuongNho]

Dear anh HieuCD,
Em đã tạo topic rồi mà k biết tag sao cho anh thấy,
Em mượn đỡ bài này gửi link anh xem giúp:
http://www.giaiphapexcel.com/diendan/threads/vba-copy-sheet-khác-file.125081/

(2 bài trước của em cũng chưa đâu tới đâu, nếu được anh chỉ giúp em luôn với:
http://www.giaiphapexcel.com/dienda...et-qua-sheet-co-dieu-kien.125029/#post-783315
http://www.giaiphapexcel.com/diendan/threads/code-copy-không-bị-mất-dữ-liệu-có-trước.124948/ )

Cám ơn Anh!

 

[khoa289]

Mượn code của bạn Pacific PR để làm cho bạn.