Dùng Code gì để nối các bảng tại các Sheet (cấu trúc giống nhau) vào 1 Sheet THợp

Liên hệ QC

Dauthivan

Thành viên tiêu biểu
Tham gia
15/8/08
Bài viết
565
Được thích
327
Em lại xin phiền mọi người chút nữa, kiến thức em chưa có nhiều nên chưa thực hiện được.

Các Sheet của em có đặc điểm là cấu trúc giống hệt nhau, nay em muốn nối (hợp nhất) nội dung các Sheet đó, tổng hợp vào 1 Sheet duy nhất,

Ghi chú: Dòng tiêu đề của bảng (tại tất cả các Sheet giống hệt nhau- dòng 1) khi thực hiện tổng hợp nó chỉ xuất hiện 1 lần trên cùng tại Sheet kết quả.
 

File đính kèm

Được anh Nghĩa Phúc và Anh Trungvdb tận tình hướng dẫn mà không hiểu sao làm mãi vẫn lỗi lọc chẳng ra cái gì cả.

Xin giúp cho em với

Các bạn ơi, các bạn phải nhớ khi lấy dữ liệu ở nguồn nào đó, các bạn phải thêm tên sheet vào để không xảy ra những việc đáng tiếc các bạn ơi!

Thay vì:

PHP:
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A1:J" & Dongcuoi).Value

Thì phải nên:

Mã:
Dongcuoi = [COLOR=#ff0000][B]Sheet15[/B][/COLOR].[A65000].End(xlUp).Row
DL = [COLOR=#ff0000][B]Sheet15[/B][/COLOR].Range("A1:J" & Dongcuoi).Value
 
Upvote 0
Số 10 nó có ở ô B6 (SheetTonghop) mà thày, nhưng kể cả trong trường hợp mình cố tình gõ các con số 10,41,42 vào cột B nó cũng không ra thày ah.

Tức là ý tác giả muốn tại SheetTonghop nếu những ô nào cột B có giá trị trùng với các giá trị Arr (trong bài này cụ thể là 10,41,42) thì lọc mà thực chất là Copy toàn bộ dòng của ô đấy sang Sheet!Loc thày ah
Ah... thấy rồi
Vậy là sai chổ này
Mã:
With Sheets("TongHop")
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A1:J" & Dongcuoi).Value
thiếu dấu chấm
Lý ra phải là
Mã:
With Sheets("TongHop")
Dongcuoi = [COLOR=#ff0000][SIZE=5].[/SIZE][/COLOR][A65000].End(xlUp).Row
DL = [COLOR=#ff0000][SIZE=5].[/SIZE][/COLOR]Range("A1:J" & Dongcuoi).Value
 
Upvote 0
Đúng là được rồi thày ah
Như vậy Code đúng là
PHP:
Sub Loc()
    Dim Arr(), DL(), KQ(), Dongcuoi As Long, i As Long, j As Long, m As Long
    On Error GoTo NextStep
    i = Sheets("Loc").Index
NextStep:
    If i = 0 Then Sheets.Add.Name = "Loc"
    Sheets("Loc").Move Before:=Sheets(1)
   
    With Sheets("TongHop") ''Có the dung:   With Sheet15
        .[1:4].Copy Sheets("Loc").[A1]
        Dongcuoi = .[A65000].End(xlUp).Row
        DL = .Range("A5:J" & Dongcuoi).Value
    End With
 
    ReDim KQ(1 To UBound(DL, 1), 1 To UBound(DL, 2))
    Arr = Array(10, 41, 42)
    Set Dic = CreateObject("Scripting.Dictionary")
   
    For i = 0 To UBound(Arr, 1)
        Tmp = Arr(i)
        If Not Dic.Exists(Tmp) Then Dic.Add Tmp, ""
    Next
   
    For j = 1 To UBound(DL, 1)
        If Dic.Exists(DL(j, 2)) Then
            m = m + 1
            For i = 1 To 10
                KQ(m, i) = DL(j, i)
            Next
        End If
    Next
   
    With Sheets("Loc")
        .Range("A5:J1000").ClearContents
        .[A5].Resize(m, 10).Value = KQ
        .UsedRange.Font.Name = ".VnTime"
.UsedRange.Font.Size = 12
.UsedRange.EntireColumn.AutoFit
.UsedRange.EntireRow.AutoFit
.UsedRange.NumberFormat = "#,##0"
    End With
End Sub

(Ơ nhưng tại sao lúc trưa cũng lọc bài tương tự mà thiếu dấu chấm nó vẫn chạy nhỉ; sao cái cần, cái lại cóc cần vậy ta).
 
Lần chỉnh sửa cuối:
Upvote 0
Ah... thấy rồi
Vậy là sai chổ này
Mã:
With Sheets("TongHop")
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A1:J" & Dongcuoi).Value
thiếu dấu chấm
Lý ra phải là
Mã:
With Sheets("TongHop")
Dongcuoi = [COLOR=#ff0000][SIZE=5].[/SIZE][/COLOR][A65000].End(xlUp).Row
DL = [COLOR=#ff0000][SIZE=5].[/SIZE][/COLOR]Range("A1:J" & Dongcuoi).Value

Sao em thấy các bạn này "lạm dụng" thủ tục With ... End With quá nhỉ? Khi nào có từ 3 cái chung trở lên và gần như liên tục với nhau thì ta nên dùng With, còn không viết hẳn vào luôn chứ lạm dụng quá rồi có khi lại quên cái End With hoặc nhìn nó cứ rối mắt ra.
 
Upvote 0
Cũng là code của các bạn, nhưng trình bày gọn một tí sẽ thấy nó tường minh và đẹp mắt hơn:

Mã:
Sub Loc()
    Dim Arr(), DL(), KQ(), Dongcuoi As Long, i As Long, j As Long, m As Long
    On Error GoTo NextStep
    i = Sheets("Loc").Index
NextStep:
    If i = 0 Then Sheets.Add.Name = "Loc"
    Sheets("Loc").Move Before:=Sheets(1)
    
    [B][COLOR=#0000cd]With Sheets("TongHop") [/COLOR][COLOR=#006400]''Có the dung:   With Sheet15[/COLOR][/B]
        .[1:4].Copy Sheets("Loc").[A1]
        Dongcuoi = .[A65000].End(xlUp).Row
        DL = .Range("A5:J" & Dongcuoi).Value
    [COLOR=#0000cd][B]End With[/B][/COLOR]

    ReDim KQ(1 To UBound(DL, 1), 1 To UBound(DL, 2))
    Arr = Array(10, 41, 42)
    Set Dic = CreateObject("Scripting.Dictionary")
    
    For i = 0 To UBound(Arr, 1)
        Tmp = Arr(i)
        If Not Dic.Exists(Tmp) Then Dic.Add Tmp, ""
    Next
    
    For j = 1 To UBound(DL, 1)
        If Dic.Exists(DL(j, 2)) Then
            m = m + 1
            [COLOR=#0000cd]For i = 1 To 10
                KQ(m, i) = DL(j, i)
            Next[/COLOR]
        End If
    Next
    
    With Sheets("Loc")
        .Range("A5:J1000").ClearContents
        .[A5].Resize(m, 10).Value = KQ
        .UsedRange.EntireColumn.AutoFit
        .UsedRange.EntireRow.AutoFit
    End With
End Sub
 
Upvote 0
(Ơ nhưng tại sao lúc trưa cũng lọc bài tương tự mà thiếu dấu chấm nó vẫn chạy nhỉ; sao cái cần, cái lại cóc cần vậy ta).
Nếu không chỉ rõ là sheet nào thì.. hên xui. Vùng dữ liệu lúc đó sẽ được xem là nằm tại ActiveSheet. Quan trọng là khi chạy code, ta đang "đứng" ở sheet nào
Vậy, khi viết code, ta viết càng rõ ràng thì càng không bị hiểu lầm ---> Sau này viết code cho nhiều Workbook, chẳng những phải chỉ rõ vùng dữ liệu nằm ở sheet nào mà còn phải cho biết nó nằm ở Workbook nào nữa đấy
------------------
Sao em thấy các bạn này "lạm dụng" thủ tục With ... End With quá nhỉ? Khi nào có từ 3 cái chung trở lên và gần như liên tục với nhau thì ta nên dùng With, còn không viết hẳn vào luôn chứ lạm dụng quá rồi có khi lại quên cái End With hoặc nhìn nó cứ rối mắt ra.
Học 1 chuyện, áp dụng và tùy biến thế nào lại là chuyện khác mà...
Tóm lại: mình tự chịu trách nhiệm lấy với những gì mình viết (đúng, sai, thiếu, thừa hay... tào lao.. ráng chịu)
Ẹc... Ẹc...
 
Lần chỉnh sửa cuối:
Upvote 0
1. Thêm 1 sheet mới vào đầu Workbook (đây sẽ là kết quả của việc nối dữ liệu của các sheet kia).
2. Sử dụng code sau cho sheet tổng hợp này:
PHP:
Private Sub Worksheet_Activate()
    Dim i As Long
    UsedRange.Offset(1).Clear
    For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).UsedRange.Offset(1).Copy [A65536].End(xlUp).Offset(1)
    Next
End Sub
3. Mỗi lần sheet tổng hợp được chọn (chuyển qua lại giữa các sheet), dữ liệu từ các sheet kia sẽ được nối lại vào đây.

Cảm ơn Sư phụ! Cái này của sư phụ rất hữu dụng. Tuy nhiên, bây giờ Đệ muốn thêm khoảng 5-6 dòng lên phía trên của vùng dữ liệu thì phải sửa lại code như thế nào ạ?
Đệ sửa mãi mà không được mong các sư phụ sửa giúp.
 
Upvote 0
Cảm ơn Sư phụ! Cái này của sư phụ rất hữu dụng. Tuy nhiên, bây giờ Đệ muốn thêm khoảng 5-6 dòng lên phía trên của vùng dữ liệu thì phải sửa lại code như thế nào ạ?
Đệ sửa mãi mà không được mong các sư phụ sửa giúp.

Bạn muốn thêm như thế nào, tôi không hiểu lắm? Hay bạn gửi cái file mẫu lên và nói rõ yêu cầu đó chứ?
 
Upvote 0
Cảm ơn Sư phụ! Cái này của sư phụ rất hữu dụng. Tuy nhiên, bây giờ Đệ muốn thêm khoảng 5-6 dòng lên phía trên của vùng dữ liệu thì phải sửa lại code như thế nào ạ?
Đệ sửa mãi mà không được mong các sư phụ sửa giúp.
Bạn thêm câu lệnh này vào vị trí phù hợp nhé: [1:5].Insert
 
Upvote 0
Sư phụ ơi! Đệ làm rồi nhưng nó cứ bị như file đính kèm.
Sư phụ giữa giúp Đệ với!
 

File đính kèm

Upvote 0
Sư phụ ơi! Đệ làm rồi nhưng nó cứ bị như file đính kèm.
Sư phụ giữa giúp Đệ với!
Ay za! Đúng là chưa thấy mặt thì không thể nói càn được. Đọc yêu cầu trên kia, mình lại cứ nghĩ là thêm 5 dòng vào đầu sheet Tong hop, hóa ra trật lất. Theo file của bạn thì các sheet thành phần, dữ liệu bắt đầu từ hàng 3. Vậy thì sửa lại code như vầy cho sheet Tong hop xem sao:
PHP:
Private Sub Worksheet_Activate()
    Dim i As Long
    UsedRange.Offset(1).Clear
    For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).[A3].CurrentRegion.Offset(1).Copy [A65536].End(xlUp).Offset(1)
    Next
End Sub
(nhớ là sheet Tong hop phải luôn có sẵn dòng tiêu đề đấy nhé).
 
Upvote 0
Các cao nhân chỉ giáo dùm mình với...........

Dear các Cao nhân

Mình mới tập tò với VBA, qua quá trình tham khảo trên GPE mình thấy các cao nhân rất tuyệt chiêu.

Nhưng khổ nổi mình chưa học được nhiều.

Nay có file update dữ liệu từ sản xuất, như đính kèm. Nhờ các cao nhân chỉ hộ.

Mình có copy vài code VBA trên diễn đàn. Nhưng xử lý không được. Đối với trường hợp, sau khi lấy dữ liệu từ bên ngoài => được các sheet từ ....(1),.... (2), .....(12), và có thể nhiều hơn nữa. Và sau đó chạy code Nối bảng để được sheet " Tổng hợp". Nhưng không được. Vì:

1- Sheet "tổng hợp" chỉ update được các dữ liệu của chỉ 4 hoặc 5 sheet con thôi.

2- Muốn chỉ update 1 tiêu đề của 1 sheet con duy nhất thôi (không update lặp lại các tiêu đề của các sheet con khác- vì các sheet con có tiêu đề giống nhau).
3- Các sheet con điều có dữ liệu bắt đầu từ hàng số 9, và hàng kết thúc không xác định (có thể thay đổi.
4- Chỉ update những hàng trong sheet con có số liệu (những hàng không có số liệu thì không cần update. Sau khi update vào Sheet "Tổng hợp" thì các dữ liệu trong sheet "tổng hợp" được xếp liên tục (không bị gián đọan bởi bất cứ hàng trống nào trong vùng dữ liệu).

=> Vậy có cách nào khắc phục các vấn đề trên, và viết code như thế nào ?- Mong các Cao nhân giúp đỡ.

Chân thành cám ơn!
 

File đính kèm

Upvote 0
Hic hic hic.... Sư phụ ơi, vẫn không được,

Đệ upload lại, sư phụ sửa thẳng vào cho Đệ nhé.

Cảm ơn Sư phụ nhiều lắm!
 

File đính kèm

Upvote 0
Hic hic hic.... Sư phụ ơi, vẫn không được,
Đệ upload lại, sư phụ sửa thẳng vào cho Đệ nhé.
Cảm ơn Sư phụ nhiều lắm!
Cứ mỗi lúc bạn lại đưa file theo 1 kiểu khác nhau. Thôi thì như vầy: Bạn sử dụng code sau nhé:
PHP:
Private Sub Worksheet_Activate()
    Dim i As Long
    [A7].CurrentRegion.Offset(2).Clear
    For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).[A7].CurrentRegion.Offset(2).Copy [A65536].End(xlUp).Offset(1)
    Next
    If [A65536].End(xlUp).Row >= 9 Then
        [A9] = 1
        [A9].DataSeries Rowcol:=xlColumns, Step:=1, Stop:=[A65536].End(xlUp).Row - 8
    End If
End Sub
Nếu vẫn không ưng ý thì bạn hãy đưa file giống với thực tế nhất lên đây.
 

File đính kèm

Upvote 0
Cứ mỗi lúc bạn lại đưa file theo 1 kiểu khác nhau. Thôi thì như vầy: Bạn sử dụng code sau nhé:
PHP:
Private Sub Worksheet_Activate()
    Dim i As Long
    [A7].CurrentRegion.Offset(2).Clear
    For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).[A7].CurrentRegion.Offset(2).Copy [A65536].End(xlUp).Offset(1)
    Next
    If [A65536].End(xlUp).Row >= 9 Then
        [A9] = 1
        [A9].DataSeries Rowcol:=xlColumns, Step:=1, Stop:=[A65536].End(xlUp).Row - 8
    End If
End Sub
Nếu vẫn không ưng ý thì bạn hãy đưa file giống với thực tế nhất lên đây.

Thôi, không gọi là sư phụ nữa, khách sáo lắm!
Cảm ơn bạn rất nhiều! Tôi thấy bạn rất nhiệt tình và thành thạo. Giá như trình độ của Tôi mà bằng 1/4 của bạn thôi thì nó đã giúp ích trong công việc của Tôi rất nhiều rồi.
Bạn đừng có giận, chẳng qua là Tôi vừa muốn học, vừa muốn mầy mò thôi, chứ cứ để bạn làm giúp cho toàn bộ thì bao giờ Tôi mới khá lên được.

Cảm ơn bạn nhiều nhiều nhé!
 
Upvote 0
1. Thêm 1 sheet mới vào đầu Workbook (đây sẽ là kết quả của việc nối dữ liệu của các sheet kia).
2. Sử dụng code sau cho sheet tổng hợp này:
PHP:
Private Sub Worksheet_Activate()
    Dim i As Long
    UsedRange.Offset(1).Clear
    For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).UsedRange.Offset(1).Copy [A65536].End(xlUp).Offset(1)
    Next
End Sub
3. Mỗi lần sheet tổng hợp được chọn (chuyển qua lại giữa các sheet), dữ liệu từ các sheet kia sẽ được nối lại vào đây.

Nếu muốn cho đoạn code trên chỉ gộp những dữ liệu từ các sheet mà mình quy định trước,thì phải sửa lại như thế nào ? Ví dụ sheet"TH" chỉ gộp dữ liệu từ các sheet"P1" , "P2" , "P3" , "P4" , "P5" và "P6" ,còn các sheet khác thì bỏ qua.các bạn sửa giúp mình nhé,cảm ơn
 
Upvote 0
Nếu muốn cho đoạn code trên chỉ gộp những dữ liệu từ các sheet mà mình quy định trước,thì phải sửa lại như thế nào ? Ví dụ sheet"TH" chỉ gộp dữ liệu từ các sheet"P1" , "P2" , "P3" , "P4" , "P5" và "P6" ,còn các sheet khác thì bỏ qua.các bạn sửa giúp mình nhé,cảm ơn
Bạn sửa lại như vầy nhé:
PHP:
Private Sub Worksheet_Activate()
    Dim Ws As Worksheet
    UsedRange.Offset(1).Clear
    For Each Ws In ThisWorkbook.Sheets
        If InStr(".P1.P2.P3.P4.P5.P6.", "." & Ws.Name & ".") > 0 Then Ws.UsedRange.Offset(1).Copy [A65536].End(xlUp).Offset(1)
    Next
End Sub
 
Upvote 0
Bạn cứ dịch tiếng Anh sang tiếng Việt thì UsedRange nghĩa là "vùng đã được dùng", tức là toàn bộ vùng có chứa dữ liệu trên 1 sheet nào đó, hay nói chính xác là một vùng chữ nhật bé nhất chứa tất cả các ô có dữ liệu trên sheet. Sử dụng UsedRange có một điểm lợi so với việc không dùng nó là ở chỗ: VBA tự động nhận biết đây là vùng nào (mấy hàng, mấy cột, bắt đầu từ đâu) mà ta không cần xác định trong câu lệnh.
Trong câu lệnh Sheets(i).UsedRange.Offset(1).Copy .[A65536].End(xlUp).Offset(1) thì .[A65536].End(xlUp).Offset(1) được hiểu là từ ô A65536 chạy lên trên (.End(xlUp)), gặp ô đầu tiên có dữ liệu thì nhảy xuống dưới 1 ô (.Offset(1)). Còn Sheets(i).UsedRange.Offset(1) tức là toàn bộ vùng chứa dữ liệu trên Sheet thứ i đem dịch chuyển xuống dưới 1 hàng (tức là trừ hàng tiêu đề). Như vậy, toàn bộ câu lệnh này được hiểu là copy toàn bộ vùng dữ liệu tại sheet thứ i (trừ hàng tiêu đề) và dán kế tiếp vào phần đã có dữ liệu tại sheet TongHop.
Nếu muốn thay bởi cụm khác thì có thể làm như vầy:
PHP:
Sheets(i).[2:65536].Copy .[A65536].End(xlUp).Offset(1)
Ở đây, Sheets(i).[2:65536] là để phòng hờ thôi, thực chất thì dữ liệu trên Sheets(i) không nhập đến hàng thứ 65536.
Tổng quát hơn nữa thì thêm một biến eRow để xác định hàng cuối cùng trong bảng tính và thay vào cho số 65536, vì con số này thay đổi tùy thuộc phiên bản Excel.

Bạn ơi cho mình hỏi.
Nếu 2 sheet gop lại vào sheet tổng hợp mà khối lượng lớn hơn 70000 dòng thì làm thế nào.
Mong bạn gửi giúp mình ví dụ nhé.
thanks
 
Upvote 0
Bạn sửa lại như vầy nhé:
PHP:
Private Sub Worksheet_Activate()
    Dim Ws As Worksheet
    UsedRange.Offset(1).Clear
    For Each Ws In ThisWorkbook.Sheets
        If InStr(".P1.P2.P3.P4.P5.P6.", "." & Ws.Name & ".") > 0 Then Ws.UsedRange.Offset(1).Copy [A65536].End(xlUp).Offset(1)
    Next
End Sub

Bạn thông cảm vì đã ko hỏi hết ý !!! ,bạn giúp mình sửa lại code lại như sau:sheet"TH" Sẽ gộp dữ liệu của các sheet"P1" đến "P6" từ hàng thứ 5 (Từ hàng 1:4 của các sheet trên đều có tiêu đề giống nhau) Tức là dữ liệu được Pate vào sheet"TH" Sẽ bắt đầu từ hàng thứ 5.cảm ơn bạn nhiều.
 
Upvote 0
Bạn sửa lại như vầy nhé:
PHP:
Private Sub Worksheet_Activate()
    Dim Ws As Worksheet
    UsedRange.Offset(1).Clear
    For Each Ws In ThisWorkbook.Sheets
        If InStr(".P1.P2.P3.P4.P5.P6.", "." & Ws.Name & ".") > 0 Then Ws.UsedRange.Offset(1).Copy [A65536].End(xlUp).Offset(1)
    Next
End Sub

Bạn ơi,sao đoạn code trên nó ko hoạt động,bạn xem và sửa lại giúp mình với.
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom