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

MinhKhai · 14/8/17

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

ndu96081631 · 14/8/17

MinhKhai đã viết:
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
???

befaint · 14/8/17

MinhKhai đã viết:
số HĐ (cột A)

?

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

MinhKhai · 14/8/17

Em cảm ơn

MinhKhai · 14/8/17

ndu96081631 đã viết:
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

ndu96081631 · 14/8/17

MinhKhai đã viết:
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"

MinhKhai · 14/8/17

ndu96081631 đã viết:
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

ndu96081631 · 14/8/17

MinhKhai đã viết:
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

VetMini · 14/8/17

MinhKhai đã viết:
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.

MinhKhai · 14/8/17

ndu96081631 đã viết:
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.

MinhKhai · 14/8/17

VetMini đã viết:
{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 ạ

befaint · 14/8/17

MinhKhai đã viết:
Cảm ơn anh @befaint, Code ở #3 chạy tốt.

Ở bài #3 có một câu hỏi mà?

MinhKhai · 14/8/17

befaint đã viết:
Ở bài #3 có một câu hỏi mà?

Như đã mô tả, cột A tại các sheet (trừ sheet Consol) là cột Invoice No (số Hóa đơn). Dữ liệu tại cột này là dữ liệu nguồn để Paste sang sheet Consol
Tks

befaint · 15/8/17

MinhKhai đã viết:
Như đã mô tả, cột A tại các sheet (trừ sheet Consol) là cột Invoice No (số Hóa đơn)

Vui lòng kiểm tra kỹ lại nhá! 8 sheets đầu khác với những sheets còn lại đấy!!!

befaint · 15/8/17

?

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

tuanhuycntt · 16/8/17

@befaint Bác thông dịch thật bá đạo. Thế này chẳng đọc dễ hiểu quá ý

Like bác

ybvba · 15/9/20

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 ạ

BuiQuangThuan · 15/9/20

ybvba đã viết:
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 ạ

Bạn thử tìm hiểu thêm về ado coi

ybvba · 15/9/20

buiquangthuan đã viết:
Bạn thử tìm hiểu thêm về ado coi

Em sẽ nghiên cứu ạ, bác có thể giúp em sửa code file trên không ạ. Em cảm ơn

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

Giải pháp Ếc-xào

File đính kèm

Huyền thoại GPE

|||||||||||||

Giải pháp Ếc-xào

Giải pháp Ếc-xào

Huyền thoại GPE

Giải pháp Ếc-xào

Huyền thoại GPE

Ăn cùng góc phố

Giải pháp Ếc-xào

Giải pháp Ếc-xào

|||||||||||||

Giải pháp Ếc-xào

|||||||||||||

|||||||||||||

Thành viên chính thức

Thành viên mới

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên mới