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 (1 người xem)

[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)

 

[Hoàng Trọng Nghĩa]

Đượ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ì:

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

Thì phải nên:

Dongcuoi = [COLOR=#ff0000][B]Sheet15[/B][/COLOR].[A65000].End(xlUp).Row
DL = [COLOR=#ff0000][B]Sheet15[/B][/COLOR].Range("A1:J" & Dongcuoi).Value

 

[ndu96081631]

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

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à

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

 

[trungvdb]

Đúng là được rồi thày ah
Như vậy Code đúng là

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

 

[Hoàng Trọng Nghĩa]

Ah... thấy rồi
Vậy là sai chổ này

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à

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.

 

[Hoàng Trọng Nghĩa]

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:

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

 

[ndu96081631]

(Ơ 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...

 

[Thanhvietin]

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.

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.

 

[Hoàng Trọng Nghĩa]

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ứ?

 

[nghiaphuc]

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

 

[Thanhvietin]

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!

 

[nghiaphuc]

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:

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é).

 

[phu.nguyencenter]

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!

 

[Thanhvietin]

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!

 

[nghiaphuc]

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é:

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.

 

[Thanhvietin]

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é:

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é!

 

[khamha]

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.

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

 

[nghiaphuc]

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é:

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

 

[tuangiang25022008]

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.

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

 

[khamha]

Bạn sửa lại như vầy nhé:

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.

 

[khamha]

Bạn sửa lại như vầy nhé:

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.