Duyệt qua các sheet để copy dữ liệu (VBA)

Liên hệ QC

MinhKhai

Giải pháp Ếc-xào
Tham gia
16/4/08
Bài viết
934
Được thích
568
Em có yêu cầu sau rất đơn giản, đã thử nghiệm làm trên VBA mà không thành công.
File gồm nhiều sheet, tên sheet chính là ngày tháng. Trong file có 1 sheet tổng hợp.
Khi mở sheet Tổng hợp, code hoạt động như sau: Copy các dữ liệu là số HĐ (cột A) lần lượt từ các sheet trong file và Paste vào cột C trong sheet Consol. Dữ liệu được dán nối tiếp nhau đến hết.

Em đang tập tành VBA. Mong được giúp code đơn giản, dễ hiểu, dễ điều chỉnh khi dữ liệu nguồn hoặc dữ liệu đích thay đổi địa chỉ.

Xin cảm ơn
 

File đính kèm

  • Tinh hinh su dung hoa don thang 7.xlsx
    818.5 KB · Đọc: 57
Em có yêu cầu sau rất đơn giản, đã thử nghiệm làm trên VBA mà không thành công.
File gồm nhiều sheet, tên sheet chính là ngày tháng. Trong file có 1 sheet tổng hợp.
Khi mở sheet Tổng hợp, code hoạt động như sau: Copy các dữ liệu là số HĐ (cột A) lần lượt từ các sheet trong file và Paste vào cột C trong sheet Consol. Dữ liệu được dán nối tiếp nhau đến hết.

Em đang tập tành VBA. Mong được giúp code đơn giản, dễ hiểu, dễ điều chỉnh khi dữ liệu nguồn hoặc dữ liệu đích thay đổi địa chỉ.

Xin cảm ơn
Cứ cho rằng bạn có cái code ấy rồi đi! Vậy nó sẽ làm việc như sau:
- Khi bạn Active sheet "Consol Invoice" thì code sẽ duyệt qua tất cả các sheet (trừ sheet Consol Invoice) và copy toàn bộ dữ liệu cột B, dán nối đuôi vào cột C của sheet Consol Invoice
- Sau đó bạn chuyển sang 1 sheet khác để làm việc nhưng không nhập liệu gì cả (chỉ kiểm tra.. chơi thôi)
- Giờ bạn quay lại sheet "Consol Invoice", điều gì sẽ xảy ra? Nó lại copy tiếp à? Vậy chỉ cần nhảy qua nhảy lại giữa Consol Invoice và 1 sheet khác thì trong vòng 10 lần bạn sẽ có được 1.. rừng
???
 
Upvote 0
?
PHP:
Sub hibe()
Const sName As String = "Consol Invoice"
Const chk As String = "Invoice No"
Dim ws0 As Worksheet, ws As Worksheet, wsName As String, Cll As Range
Dim lRow As Long, arrTmp(), Result(1 To 1048500, 1 To 2), i As Long, j As Long, M As Variant, dDate As Date
Set ws0 = Sheets(sName)
Application.Calculation = xlCalculationManual
For Each ws In ThisWorkbook.Worksheets
    wsName = ws.Name
    If wsName <> sName Then
        M = Split(wsName, "-")
        If UBound(M) < 1 Then GoTo NextCode     '--'
        dDate = DateSerial(Year(Date), CLng(M(1)), CLng(M(0)))
        Set Cll = IIf(ws.Range("A3").Value = chk, ws.Range("A4"), ws.Range("B4"))
        lRow = LastRow(ws, Cll)
        If lRow <= 3 Then GoTo NextCode         '--'
        Erase arrTmp
        arrTmp = Cll.Resize(lRow - 3, 2).Value
        Set Cll = Nothing
        If j = 1048500 Then MsgBox "Kêt qua nhiêu qua!": Exit For
        For i = 1 To UBound(arrTmp, 1)
            j = j + 1
            Result(j, 1) = dDate
            Result(j, 2) = arrTmp(i, 1)
        Next i
    End If
NextCode:
Next ws
If j Then
    ws0.Range("B2:B1048576").ClearContents
    ws0.Range("B2").Resize(j, 2) = Result
    ws0.Range("B2").Resize(j, 2).Sort Key1:=ws0.Range("C2")
End If
Application.Calculation = xlCalculationAutomatic
End Sub
'------------'
Function LastRow(ws As Worksheet, Cll As Range) As Long
    If ws.FilterMode = True Then ws.ShowAllData
    ws.Cells.EntireRow.Hidden = False
    LastRow = ws.Cells(ws.Rows.Count, Cll.Column).End(xlUp).Row
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Cứ cho rằng bạn có cái code ấy rồi đi! Vậy nó sẽ làm việc như sau:
- Khi bạn Active sheet "Consol Invoice" thì code sẽ duyệt qua tất cả các sheet (trừ sheet Consol Invoice) và copy toàn bộ dữ liệu cột B, dán nối đuôi vào cột C của sheet Consol Invoice
- Sau đó bạn chuyển sang 1 sheet khác để làm việc nhưng không nhập liệu gì cả (chỉ kiểm tra.. chơi thôi)
- Giờ bạn quay lại sheet "Consol Invoice", điều gì sẽ xảy ra? Nó lại copy tiếp à? Vậy chỉ cần nhảy qua nhảy lại giữa Consol Invoice và 1 sheet khác thì trong vòng 10 lần bạn sẽ có được 1.. rừng
???
Bác nói đúng ý em muốn, mỗi lần nhảy qua nhảy lại nó làm việc giống hệt việc trước đó.
Chỉ có 1 chi tiết em xin nêu rõ để bác giúp em là: Vì việc copy của mỗi lần là như nhau lên nên ý của em là trước khi code làm công việc copy, mình lệnh cho nó ClearContent TẤT CẢ dữ liệu cũ.
Vậy ko có dữ liệu trùng lặp và không có rừng nào cả.
Em cảm ơn
 
Upvote 0
Bác nói đúng ý em muốn, mỗi lần nhảy qua nhảy lại nó làm việc giống hệt việc trước đó.
Chỉ có 1 chi tiết em xin nêu rõ để bác giúp em là: Vì việc copy của mỗi lần là như nhau lên nên ý của em là trước khi code làm công việc copy, mình lệnh cho nó ClearContent TẤT CẢ dữ liệu cũ.
Vậy ko có dữ liệu trùng lặp và không có rừng nào cả.
Em cảm ơn
Bạn suy nghĩ cũng chu đáo lắm! Thế thì cũng dễ xử thôi
Tuy nhiên tôi lại đang suy nghĩ code theo hướng khác, tối ưu hơn: Cái nào có rồi thì không copy nữa, như vậy đở tốn "nhiên liệu"
 
Upvote 0
Bạn suy nghĩ cũng chu đáo lắm! Thế thì cũng dễ xử thôi
Tuy nhiên tôi lại đang suy nghĩ code theo hướng khác, tối ưu hơn: Cái nào có rồi thì không copy nữa, như vậy đở tốn "nhiên liệu"
Như ban đầu em đã nêu, bài toán vừa là giải quyết yêu cầu của em nhưng vừa là để em tập tành về code. Em muốn code vừa đơn giản vừa dễ hiểu để học tập đồng thời có thể sửa chữa khi yêu cầu ban đầu của mình có chút thay đổi.
Tư duy của em về giải bài toán là tư duy của người ko có căn bản về VBA. Mong bác tận tình hướng dẫn
 
Upvote 0
Như ban đầu em đã nêu, bài toán vừa là giải quyết yêu cầu của em nhưng vừa là để em tập tành về code. Em muốn code vừa đơn giản vừa dễ hiểu để học tập đồng thời có thể sửa chữa khi yêu cầu ban đầu của mình có chút thay đổi.
Tư duy của em về giải bài toán là tư duy của người ko có căn bản về VBA. Mong bác tận tình hướng dẫn
Bạn cứ xem thử bài 3 được hay không rồi tính tiếp
 
Upvote 0
Như ban đầu em đã nêu, bài toán vừa là giải quyết yêu cầu của em nhưng vừa là để em tập tành về code. Em muốn code vừa đơn giản vừa dễ hiểu {1} để học tập đồng thời có thể sửa chữa khi yêu cầu ban đầu của mình có chút thay đổi {2}.
Tư duy của em về giải bài toán là tư duy của người ko có căn bản về VBA {3} . Mong bác tận tình hướng dẫn

{1) yêu cầu của bạn khong đơn giản cho nên bảo code vừa đơn giản vừa dễ hiểu là chuyện rất khó. Thêm nữa, trường phái viết code chung ở diễn đàn này là chú trọng tốc độ chứ không phải dễ hiểu cho nên lại càng khó thể xảy ra.
Cách duy nhất để "dễ hiểu" là bạn tự ghi ra tuần tự các bước của giải pháp của chính mình, đưa lên đây nhờ dịch các bước ấy ra VBA.

{2} như điều 1 ở trên, bạn phải trực tiếp yêu cầu người viết code viết theo kiểu có thông số riêng (ví dụ dùng Constant List). Khi cần sửa chữa thì chỉ phải sửa các thông số.

{3} với yêu cầu của bài, người không có căn bản về VBA không thể tư duy.
 
Upvote 0
Bạn cứ xem thử bài 3 được hay không rồi tính tiếp
Cảm ơn anh @befaint, Code ở #3 chạy tốt.
Nhưng thú thực là em không hiểu từng dòng code.

Tư duy ban đầu của em khi định viết code là:
1. Code được đặt trong 1 có Sub có chức năng sheet_activate
2. Tạo lệnh lặp để duyệt qua các sheet
3. Tại sheet đầu tiên đang active, xác định khối dữ liệu và copy
4. Sang sheet TongHop để Paste từ ô C2
5. Vòng lặp chuyển sang sheet thứ 2 đang active
6. Cũng xác định khối dữ liệu và copy. Nhưng khi sang sheet TongHop để paste thì End(xlUp) để xác định dòng bắt đầu Paste.
7. Vòng lặp duyệt sheet chạy xong như bước trên
8. Sắp xếp dữ liệu.

Với suy nghĩ trên, em tính Record macro rồi lắp ráp code. Nhưng suy nghĩ là vậy nhưng khi bắt tay vào việc, việc nó hổng có giống mình nghĩ và có những phát sinh khác không xử lý được
Vậy nên khi nhìn code của @befaint tuy chạy đúng yêu cầu nhưng rất khó hiểu với người ngoại đạo như em
Dù sao em vẫn rất cảm ơn mọi người.
 
Upvote 0
{1) yêu cầu của bạn khong đơn giản cho nên bảo code vừa đơn giản vừa dễ hiểu là chuyện rất khó. Thêm nữa, trường phái viết code chung ở diễn đàn này là chú trọng tốc độ chứ không phải dễ hiểu cho nên lại càng khó thể xảy ra.
Cách duy nhất để "dễ hiểu" là bạn tự ghi ra tuần tự các bước của giải pháp của chính mình, đưa lên đây nhờ dịch các bước ấy ra VBA.

{2} như điều 1 ở trên, bạn phải trực tiếp yêu cầu người viết code viết theo kiểu có thông số riêng (ví dụ dùng Constant List). Khi cần sửa chữa thì chỉ phải sửa các thông số.

{3} với yêu cầu của bài, người không có căn bản về VBA không thể tư duy.
Em vừa nêu ra những suy nghĩ ban đầu về code có lẽ sẽ thế ở bài trên ạ
 
Upvote 0
?
PHP:
Sub hibe_2()
Const sName As String = "Consol Invoice"        'Ten sheet gan kêt qua tong hop so hoa don (HD)'
Const chk As String = "Invoice No"              '<------ Vì Invoice No lúc o côt A, lúc o côt B'
'Khai bao cac bien can dung:'
Dim ws0 As Worksheet, ws As Worksheet, wsName As String, Cll As Range
Dim lRow As Long, arrTmp(), EndRow As Long, valDM As Variant, dDate As Date

Set ws0 = Sheets(sName)
'Gán sheet tông hop HD vào biên ws0'

Application.Calculation = xlCalculationManual
'Thiêt lâp bang tinh vê tinh toan thu công'

ws0.Range("B2:B1048576").ClearContents
'Xóa toan bô du lieu cu trong ws0 (yc-bài #5)'

For Each ws In ThisWorkbook.Worksheets
'(yc-2):'
'Vòng lap duyet qua cac sheet'

    wsName = ws.Name
    'Lây tên cua ws vào biên wsName'
 
    If wsName <> sName Then
        'Nêu thoa diêu kiên <> sName'
  
        valDM = Split(wsName, "-")
        'Tách tên sheet theo dâu phân cach "-"'
  
        If UBound(valDM) < 1 Then GoTo NextCode
        'Nêu ket qua tra ve < 1 phan tu thì nhay toi dòng "NextCode"'
  
        dDate = DateSerial(Year(Date), CLng(valDM(1)), CLng(valDM(0)))
        'Tra vê ngay/thang/nam tuong ung voi sheet dang xet'
  
        Set Cll = IIf(ws.Range("A3").Value = chk, ws.Range("A4"), ws.Range("B4")) '<------ Vì Invoice No lúc o côt A, lúc o côt B'
        'Set cell co tieu de la "Invoice No" de xác dinh vùng co HD cân tông hop'
  
        lRow = LastRow(ws, Cll)
        'Tra ve dòng cuôi co du lieu thuôc côt chua Cll'
  
        If lRow <= 3 Then GoTo NextCode
        'Nêu lRow <= 3 (dong tiêu dê) thì nhay toi dòng "NextCode"'
  
        Erase arrTmp
        'Xóa giá tri cac phân tu trong mang arrTmp'
  
        arrTmp = Cll.Resize(lRow - 3, 2).Value
        '(yc-3+5+7:'
        'Lây du lieu vùng có chua HD vào mang arrTmp,'
        'Ta Resize 2 côt de tranh lôi khi chi có mot HD'
  
        Set Cll = Nothing
        'Xoa gia tri Cll'
  
        With ws0
        '(yc-4+6):'
        'Xet ws0 - Sheet "Consol Invoice"'
            EndRow = .Range("B1048576").End(xlUp).Row + 1
            'Tra vê dòng cuôi cot [B] có du lieu trong ws0 và +1 dòng'
      
            If EndRow + UBound(arrTmp, 1) >= 1048500 Then MsgBox "Kêt qua nhiêu qua!": Exit For
            'Kiêm tra (dòng cuôi + sô kêt qua kê tiêp gán xuông ws0) so voi so dòng cua bang tinh'
            'Nêu >= 1048500 thì thoát vòng lap'
      
            .Range("B" & EndRow).Resize(UBound(arrTmp, 1), 1) = dDate
            'Gán ngày HD vao côt [B]'
      
            .Range("C" & EndRow).Resize(UBound(arrTmp, 1), 1) = arrTmp
            'Gán sô HD vao côt [C]'
        End With
    End If
NextCode:
Next ws

If EndRow > 2 Then 'Nêu có HD da tông hop duoc thi EndRow > 2'
    EndRow = ws0.Range("B1048576").End(xlUp).Row
    'Tra vê dòng cuôi cot [B] có du lieu trong ws0'
 
    ws0.Range("B2:C" & EndRow).Sort Key1:=ws0.Range("C2")
    'yc-8:'
    'Sort côt [B-C] theo A-Z cua côt [C]'
End If

Application.Calculation = xlCalculationAutomatic
'Thiêt lâp bang tinh vê tinh toan tu dông'

End Sub

'------------'
Function LastRow(ws As Worksheet, Cll As Range) As Long
'Tra vê dòng cuôi cùng có du lieu thuôc côt chua Cll'
    If ws.FilterMode = True Then ws.ShowAllData
    'Nêu dang filter thi clear'
    ws.Cells.EntireRow.Hidden = False
    'Unhide cac dong ân'
    LastRow = ws.Cells(ws.Rows.Count, Cll.Column).End(xlUp).Row
End Function
 
Upvote 0
@befaint Bác thông dịch thật bá đạo. Thế này chẳng đọc dễ hiểu quá ý :D
Like bác
 
Upvote 0
Em muốn copy dữ liệu từ workbook khác dán đè vào sheet có tên tương ứng trong workbook đang mở, các bác giúp em với. Em cảm ơn ạ
 

File đính kèm

  • Import.xlsm
    64.8 KB · Đọc: 8
Upvote 0
Web KT
Back
Top Bottom