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

[Dauthivan]

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

 

[nghiaphuc]

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:

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.

 

[Dauthivan]

Cảm ơn anh, em xin hỏi có giải pháp nào mà Tự động tạo ra Sheet tổng hợp (tự sinh) và đồng thời nó tổng hợp dữ liệu luôn của tất cả các Sheet trong file không anh (tự động đếm số Sheet), tức là chạy Macro là có kết quả ngay mà không cần phải chuyển qua lại giữa các Sheet không hả anh?

(Dữ liệu em đưa lên là số rút gọn, dữ liệu thực tế em phải làm hằng ngày hầu như file nào của em cũng có khoảng 15 Sheet, 15 cột)

Kính mong anh và mọi người giúp đỡ.

 

[nghiaphuc]

Cảm ơn anh, em xin hỏi có giải pháp nào mà Tự động tạo ra Sheet tổng hợp (tự sinh) và đồng thời nó tổng hợp dữ liệu luôn của tất cả các Sheet trong file không anh (tự động đếm số Sheet), tức là chạy Macro là có kết quả ngay mà không cần phải chuyển qua lại giữa các Sheet không hả anh?
(Dữ liệu em đưa lên là số rút gọn, dữ liệu thực tế em phải làm hằng ngày hầu như file nào của em cũng có khoảng 15 Sheet, 15 cột)
Kính mong anh và mọi người giúp đỡ.

Bạn dùng code sau nhé:

Sub NoiBang()
    Dim i As Long
    On Error Resume Next
    i = Sheets("TongHop").Index 'Trả về vị trí của sheet TongHop'
    If i = 0 Then Sheets.Add.Name = "TongHop" 'Nếu chưa có sheet TongHop thì tạo mới'
    With Sheets("TongHop")
        .Move Before:=Sheets(1) 'Chuyển lên đầu'
        .Select
        Sheets(2).[1:1].Copy .[A1] 'Copy tiêu đề'
        .UsedRange.Offset(1).Clear 'Xóa dữ liệu hiện có'
        For i = 2 To Sheets.Count
            Sheets(i).UsedRange.Offset(1).Copy .[A65536].End(xlUp).Offset(1) 'Copy dữ liệu từ các sheet khác'
        Next
        .UsedRange.EntireColumn.AutoFit 'Căn chỉnh cột'
    End With
End Sub

Bạn cũng có thể thêm code để FreezePanes cho dễ theo dõi.
Trong file đính kèm, bạn nhấn Ctrl+Shift+A để chạy code.

 

[Dauthivan]

Anh cho em hỏi các cụm từ sau có thể ghi Macro để biết nó không, ý em muốn hỏi để học nó thì tra ở đâu để có

.Move Before:=Sheets(1)
        .Select
        Sheets(2).[1:1].Copy .[A1]
        .UsedRange.Offset(1).Clear

 

[nghiaphuc]

Anh cho em hỏi các cụm từ sau có thể ghi Macro để biết nó không, ý em muốn hỏi để học nó thì tra ở đâu để có

.Move Before:=Sheets(1)
        .Select
        Sheets(2).[1:1].Copy .[A1]
        .UsedRange.Offset(1).Clear

Đang thao tác lệnh với một đối tượng (ở đây là sheet "TongHop"), cứ gõ dấu chấm một phát, nó hiện ra cả một danh sách (thuộc tính, phương thức), nhìn thấy anh nào "nghi ngờ dùng được" thì thử dùng xem thôi bạn. Thú thật là mình chưa từng được học qua VB hay VBA gì cả, toàn mò mẫm và học hỏi từ GPE thôi. Ẹc ẹc...

 

[LinDan]

Bạn dùng code sau nhé:

Sub NoiBang()
    Dim i As Long
    On Error Resume Next
    i = Sheets("TongHop").Index 'Trả về vị trí của sheet TongHop'
    If i = 0 Then Sheets.Add.Name = "TongHop" 'Nếu chưa có sheet TongHop thì tạo mới'
    With Sheets("TongHop")
        .Move Before:=Sheets(1) 'Chuyển lên đầu'
        .Select
        Sheets(2).[1:1].Copy .[A1] 'Copy tiêu đề'
        .UsedRange.Offset(1).Clear 'Xóa dữ liệu hiện có'
        For i = 2 To Sheets.Count
            Sheets(i).UsedRange.Offset(1).Copy .[A65536].End(xlUp).Offset(1) 'Copy dữ liệu từ các sheet khác'
        Next
        .UsedRange.EntireColumn.AutoFit 'Căn chỉnh cột'
    End With
End Sub

Bạn cũng có thể thêm code để FreezePanes cho dễ theo dõi.
Trong file đính kèm, bạn nhấn Ctrl+Shift+A để chạy code.

Nhờ các Pac giải thích dùm em ý nghĩa của [1:1], [A1] trong câu: Sheets(2).[1:1].Copy .[A1] là gì thế?

[A1] là [A1] của SheetTH hay Sheet(2)?

 

[ndu96081631]

Nhờ các Pac giải thích dùm em ý nghĩa của [1:1], [A1] trong câu: Sheets(2).[1:1].Copy .[A1] là gì thế?

[A1] là [A1] của SheetTH hay Sheet(2)?

[1:1] là viết tắt của Range("1:1") --> Nói chung đó là dòng 1
Sheets(2).[1:1].Copy .[A1] là copy dòng 1 của sheet2 rồi paste vào A1 của sheet TongHop
Vì trước [A1] có dấu chấm nên nó chịu ảnh hưởng của With ở dòng trên (With Sheets("TongHop")) ---> Vậy .[A1] là cell A1 của Sheet TongHop

 

[nghiaphuc]

Nhờ các Pac giải thích dùm em ý nghĩa của [1:1], [A1] trong câu: Sheets(2).[1:1].Copy .[A1] là gì thế?

[A1] là [A1] của SheetTH hay Sheet(2)?

[1:1] hay [A1] là cách viết gọn của Range("1:1"), Range("A1") (tham khảo thêm Evaluate dưới chữ ký của mình).
Ở đây Sheets(2).[1:1] thì ta hiểu đây là hàng thứ nhất của sheet thứ 2 trong danh sách các sheet (nhìn xuống nhãn sheet, từ trái sang phải), còn .[A1] ở đây là ô A1 của sheet TongHop, vì ta đã có câu lệnh .Select trước đó, nghĩa là hiện tại ta đang đứng tại sheet TongHop.

 

[LinDan]

Xin giải thích rõ hơn giúp tôi: UsedRange có nghĩa là như thế nào? Hình như nó có tác dụng nhắc đến đối tượng vừa chọn trước đó phải không?

Nếu đúng vậy,liệu có thể thay UsedRange trong cụm Sheets(i).UsedRange.Offset(1).Copy .[A65536].End(xlUp).Offset(1) bằng cụm từ khác được không?

Mục đích của tôi: Là muốn biết tại sao cần có UsedRange nếu không dùng nó có thể dùng cái nào thay thế được không?

 

[phu.nguyencenter]

Đang thao tác lệnh với một đối tượng (ở đây là sheet "TongHop"), cứ gõ dấu chấm một phát, nó hiện ra cả một danh sách (thuộc tính, phương thức), nhìn thấy anh nào "nghi ngờ dùng được" thì thử dùng xem thôi bạn. Thú thật là mình chưa từng được học qua VB hay VBA gì cả, toàn mò mẫm và học hỏi từ GPE thôi. Ẹc ẹc...

Thật nễ phục quá!!!!!
Mình cũng rất muốn học VBA, nhưng mù mẫn quá. Vì không biết bắt đầu từ đâu, toàn copy "xào-nấu" hoặc nhận chỉ dẫn lại của các cao thủ GPE không àh.
Sư phụ có cách nào tự học nhanh nhất không? Hoặc có tài liệu nào tự học OK không chia sẽ dùm đệ tử với????

 

[nghiaphuc]

Xin giải thích rõ hơn giúp tôi: UsedRange có nghĩa là như thế nào? Hình như nó có tác dụng nhắc đến đối tượng vừa chọn trước đó phải không?
Nếu đúng vậy,liệu có thể thay UsedRange trong cụm Sheets(i).UsedRange.Offset(1).Copy .[A65536].End(xlUp).Offset(1) bằng cụm từ khác được không?
Mục đích của tôi: Là muốn biết tại sao cần có UsedRange nếu không dùng nó có thể dùng cái nào thay thế được không?

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:

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.

 

[trungvdb]

Tôi đang hình dung ra cái này không biết có chập hai bước làm 1 không:

Sau khi nối bảng bằng Code (Sub) như bác Nghĩa Phúc thì để tạo Sheet mới tên là TongHop

Sub NoiBang()
    Dim i As Long
    On Error Resume Next
    i = Sheets("TongHop").Index 'Trả về vị trí của sheet TongHop'
    If i = 0 Then Sheets.Add.Name = "TongHop" 'Nếu chưa có sheet TongHop thì tạo mới'
    With Sheets("TongHop")
        .Move Before:=Sheets(1) 'Chuyển lên đầu'
        .Select
        Sheets(2).[1:1].Copy .[A1] 'Copy tiêu đề'
        .UsedRange.Offset(1).Clear 'Xóa dữ liệu hiện có'
        For i = 2 To Sheets.Count
            Sheets(i).UsedRange.Offset(1).Copy .[A65536].End(xlUp).Offset(1) 'Copy dữ liệu từ các sheet khác'
        Next
        .UsedRange.EntireColumn.AutoFit 'Căn chỉnh cột'
    End With
End Sub

Bây giờ từ Sheet!Tonghop muốn lọc ra những dòng có cột A theo tiêu chí nào đó (lớn hơn 100 chẳng hạn), kết quả lọc có thể viết ngay trên Sheet!Tonghop (hoặc Sheet mới tùy ý) tức là lúc này ta viết tiếp Sub nữa. Tức là có 2 Sub (Sub NoiBang & Sub Loc). Tức bài toán phải giải quyết bằng 2 bước:

* Bước 1: Tạo Sheet!TongHop đã

* Bước 2: Sau khi có Sheet!TongHop rồi ta thao tác bài toán lọc trên đó (nó phải tồn tại đã thì thao tác được ?)

Ý tôi muốn hỏi là:

Có cách nào mà lồng 2 Sub vào nhau không (và nếu tách ra thì có câu lệnh nào để Sub 1 tự động điều khiển Sub2 chạy) không?

 

[ndu96081631]

Bây giờ từ Sheet!Tonghop muốn lọc ra những dòng có cột A theo tiêu chí nào đó (lớn hơn 100 chẳng hạn), kết quả lọc có thể viết ngay trên Sheet!Tonghop (hoặc Sheet mới tùy ý) tức là lúc này ta viết tiếp Sub nữa. Tức là có 2 Sub (Sub NoiBang & Sub Loc). Tức bài toán phải giải quyết bằng 2 bước:

* Bước 1: Tạo Sheet!TongHop đã

* Bước 2: Sau khi có Sheet!TongHop rồi ta thao tác bài toán lọc trên đó (nó phải tồn tại đã thì thao tác được ?)

Ý tôi muốn hỏi là:

Có cách nào mà lồng 2 Sub vào nhau không (và nếu tách ra thì có câu lệnh nào để Sub 1 tự động điều khiển Sub2 chạy) không?

2 công đoạn này chẳng liên quan gì nhau cả thì cứ để chúng riêng nhau đi, khi nào chạy thì gọi

Còn muốn gọi cùng lúc 2 Sub thì

Sub Noibang
....
....
End Sub

Sub Loc
....
....
End Sub

Làm thêm 1 Sub thứ 3:

Sub Main
  Call Noibang
  Call Loc
End Sub

Chạy Sub Main nghĩa là gọi cùng lúc 2 Sub kia

 

[Dauthivan]

Đượ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ả.

Sub Loc()
    Dim Arr(), DL(), KQ(), Dongcuoi As Long, i As Long, j As Long, m As Long
    On Error Resume Next
    i = Sheets("Loc").Index
    If i = 0 Then Sheets.Add.Name = "Loc"
    With Sheets("Loc")
        .Move Before:=Sheets(1)
        .Select
        Sheets("TongHop").[1:4].Copy .[A1]
        End With
With Sheets("TongHop")
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A1:J" & Dongcuoi).Value
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, ""
        End If
Next
For j = 1 To UBound(DL, 1)
    If Dic.Exists(DL(j, 2)) Then
      m = m + 1
      KQ(m, 1) = DL(j, 1)
      KQ(m, 2) = DL(j, 2)
      KQ(m, 3) = DL(j, 3)
      KQ(m, 4) = DL(j, 4)
      KQ(m, 5) = DL(j, 5)
      KQ(m, 6) = DL(j, 6)
      KQ(m, 7) = DL(j, 7)
      KQ(m, 8) = DL(j, 8)
      KQ(m, 9) = DL(j, 9)
      KQ(m, 10) = DL(j, 10)
    End If
Next
End With
With Sheets("Loc")
.Range("A5:J1000").ClearContents
.[A5].Resize(m, 10).Value = KQ
.UsedRange.EntireColumn.AutoFit
.UsedRange.EntireRow.AutoFit
 
End With
End Sub

Xin giúp cho em với

 

[trungvdb]

Bạn kiểm tra dữ liệu lại, tôi có thêm Msgbox m kết quả thu được bằng 0 chứng tỏ không có giá trị nào cột B tại Sheet!TongHop tồn tại trong Dic dẫn đến không có dòng nào thỏa mãn (dẫn đến không có dòng nào được lọc sang).
Liên quan chuyển dữ liệu chăng, cái này bạn thử nhờ thày Ndu cùng mọi người xem sao, hiện giờ tôi chưa sử dụng cái này nên chưa thạo lắm.

Sub Loc()
    Dim Arr(), DL(), KQ(), Dongcuoi As Long, i As Long, j As Long, m As Long
    On Error Resume Next
    i = Sheets("Loc").Index
    If i = 0 Then Sheets.Add.Name = "Loc"
    With Sheets("Loc")
        .Move Before:=Sheets(1)
        .Select
        Sheets("TongHop").[1:4].Copy .[A1]
        End With

With Sheets("TongHop")
Dongcuoi = [A65000].End(xlUp).Row
DL = Range("A5:J" & Dongcuoi).Value
ReDim KQ(1 To UBound(DL, 1), 1 To UBound(DL, 2))
Arr = Array(10, 101, 1011)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(Arr, 1)
     Tmp = Arr(i)
        If Not Dic.Exists(Tmp) Then
          Dic.Add Tmp, ""
        End If
Next
For j = 1 To UBound(DL, 1)
    If Dic.Exists(DL(j, 2)) Then
      m = m + 1
      KQ(m, 1) = DL(j, 1)
      KQ(m, 2) = DL(j, 2)
      KQ(m, 3) = DL(j, 3)
      KQ(m, 4) = DL(j, 4)
      KQ(m, 5) = DL(j, 5)
      KQ(m, 6) = DL(j, 6)
      KQ(m, 7) = DL(j, 7)
      KQ(m, 8) = DL(j, 8)
      KQ(m, 9) = DL(j, 9)
      KQ(m, 10) = DL(j, 10)
    End If
Next
MsgBox m
End With
With Sheets("Loc")
.Range("A5:J1000").ClearContents
.[A5].Resize(m, 10).Value = KQ
.UsedRange.EntireColumn.AutoFit
.UsedRange.EntireRow.AutoFit
End With
End Sub

 

[ndu96081631]

Bạn kiểm tra dữ liệu lại, tôi có thêm Msgbox m kết quả thu được bằng 0 chứng tỏ không có giá trị nào cột B tại Sheet!TongHop tồn tại trong Dic dẫn đến không có dòng nào thỏa mãn lọc được sang.

Giỏi quá ta! Biết dùng MsgBox để kiểm tra
Nhớ là khi test code, ta nên bỏ dòng On Error Resume Next đi thì mới biết lỗi từ đâu ra

 

[trungvdb]

Bỏ đi nó vẫn báo lỗi 1004, tôi kiểm tra mãi không phát hiện ra thày ah? Chắc bài này thì phải nhờ các thày thì mới xong

 

[ndu96081631]

Bỏ đi nó vẫn báo lỗi 1004, tôi kiểm tra mãi không phát hiện ra thày ah? Chắc bài này thì phải nhờ các thày thì mới xong

Khi lỗi 1004 xuất hiện. bấm Debug sẽ thấy lỗi tại dòng .[A5].Resize(m, 10).Value = KQ
Lý do vì m = 0, lấy đâu mà Resize được
m = 0 chứng tỏ chẳng tìm thấy gì thỏa điều kiện cả (như bạn phát hiện)
code của tác giả có dòng Arr = Array(10, 41, 42) mà trong 2 sheet chẳng thấy số 10, 41, 42 nằm ở đâu cả
Tôi cũng chẳng hiểu mấy bài này lọc cái gì nữa

 

[trungvdb]

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ôi đoán như sau: Ban đầu tác giả chỉ có Sheet!TongHop, sau đó khi chạy Code nó sẽ sinh ra Sheet!Loc, tiếp theo đó là tác giả muốn tại SheetTonghop nếu những ô nào của 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) tức là nằm trong Dic, thì sẽ lọc toàn bộ dữ liệu (từ cột A đến cột J) của dòng chứa ô đó sang Sheet!Loc thày ah

(vì 4 dòng đầu của SheetTongHop là dòng tiêu đề nên vùng này Copy sang trước)