Chuyên đề giải đáp những thắc mắc về code VBA

maytinhvp01 · 31/7/13

Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]

SA_DQ · 30/8/19

Trong dữ liệu của từng sheet đều cố định cột từ A đến AV và đều bắt đầu từ dòng 11. Tuy nhiên đúng như bạn nói. Có 1 số cột nằm giữa A và AV trống không có dữ liệu và có 1 số dòng trống trong các sheet.
Để tối ưu hơn mình gửi file đính kèm.

Mình chạy Code của bạn đang dính lỗi này: ReDim dArr(1 To Tong, 1 To Max)
Nếu rà chuột vô tham biếm 'Max' nó đang chứa trị 16.384
Nhưng các trang của bạn không quá 52 cột. Như vậy chúng tỏ macro còn lỗi trong việc xác định số cột trong từng trang tính.
Bạn nên tìm lỗi này & trừ khử đi
Còn nếu đúng trình độ VBA của bạn trung bình thì cách này không cần kiến thức mảng gì sất, tuy chậm hơn nhưng chắc không sai:

B1: Tạo vòng lặp duyệt qua các trang (Bạn đã làm)
B2 Xác dịnh vùng dữ liệu cần chép của trang đang duyệt (Rng)
B3: Copy sang 'Total':
B3.1 Xác định dòng cuối có dữ liệu của 'Total (ví dụ là lRow)
B3.2: Thực hiện Copy vùng dữ liệu cần chép sang 'Total': Rng.Copy Destination:=Sheets("Total")..Cells(lRow,"A")

Bạn đừng nghỉ là mình sẽ viết macro xử lý cho bạn nha: Vì dữ liệu của bạn như thể đống rác như vậy mình không dám đụng đâu!

lehuuhaint · 30/8/19

Xin chào mọi người !
Nhờ mọi người giúp đỡ vấn đề như sau :
Em gửi thư hàng loạt bằng VBA qua out look nhưng gặp vấn đề là văn bản em soạn thảo trên excel không thể soạn một cái mail đẹp đẹp xíu ( kiểu chữ, canh lề chuẩn, Tô màu các điểm cần chú ý, xuống dòng, và im đậm, in nghiêng ..)
Anh chị có thể cho em hướng giải quyết về vấn đề này được ko ?

batman1 · 30/8/19

Thanh1102 đã viết:
Cảm ơn bạn. Mình đang tập tọe VBA nên không rõ.
Trong dữ liệu của từng sheet đều cố định cột từ A đến AV và đều bắt đầu từ dòng 11. Tuy nhiên đúng như bạn nói. Có 1 số cột nằm giữa A và AV trống không có dữ liệu và có 1 số dòng trống trong các sheet.
Để tối ưu hơn mình gửi file đính kèm. Bạn xem giúp mình nhé.

Công nhận là máy bạn khủng thật. Tôi chạy code của bạn snow thì không chạy được vì mảng dArr quá lớn. Cũng phải thôi vì mảng dArr có 10329 dòng và 16384 cột, tức có 10329*16384 = 169230336 phần tử. Mà mỗi phần tử ngốn 16 bai (Variant) nên mảng dArr chiếm 2 707 685 376 bai > 2 GB. Trong khi đó 2 máy tôi chỉ có 1 GB và 4 GB RAM, mà một số lớn đã chiếm bởi system và các chương trình mặc định.

Tôi đã nói rõ: Nếu trong mọi sheet dữ liệu không vượt quá cột AV thì ta luôn lấytới AV và không chơi trò Ws.[AV11].End(2).Column nữa. Mà nếu đã chơi trò END thì phải là End(xlToLeft)

Tôi chỉ sửa code của bạn snow để bạn thấy khi mảng giảm cân nhiều thì sẽ thế nào. Còn giải pháp của bạn SA_DQ thì coi như bài tập về nhà cho bạn. Nhưng nếu đúng là "Mình đang tập tọe VBA" thì bài tập quá khó với bạn đấy. Tôi không tin là trên cơ sở mấy gợi ý đó bạn sẽ tự hoàn thành được bài tập đó.

Mã:

Public Sub Noisheet()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet, tong As Long
    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> "Sum" Then
            If Ws.Name <> "Total" Then
                tong = tong + Ws.Range("B" & Rows.Count).End(xlUp).Row - 10
            End If
        End If
    Next
    If tong = 0 Or tong > Rows.Count Then
        If tong > Rows.Count Then MsgBox "nhieu dong qua"
        Exit Sub
    End If
    ReDim dArr(1 To tong, 1 To 48)     '   lay tu A toi AV = 48 cot
    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> "Sum" Then
            If Ws.Name <> "Total" Then
                I = Ws.Cells(Rows.Count, "B").End(xlUp).Row
                If I > 10 Then
                    sArr = Ws.Range("A11:AV" & I).Value
                    For I = 1 To UBound(sArr, 1)
                        K = K + 1
                        For J = 1 To UBound(sArr, 2)
                            dArr(K, J) = sArr(I, J)
                        Next J
                    Next I
                End If
            End If
        End If
    Next
    With Sheets("Total")
        .Range("A7:AV" & Rows.Count).ClearContents
        .Range("A7").Resize(K, UBound(dArr, 2)).Value = dArr
    End With
End Sub

Tôi giữ nguyên code của bạn snow nhưng thực ra theo lôgíc thì xóa dữ liệu cũ phải làm ngay từ đầu. Vì sao? Vì nếu để như bây giờ và nếu có tong > Rows.Count thì code sẽ thoát Sub mà không xóa dữ liệu cũ. Người dùng sẽ "tưởng" đó là kết quả mới.

Thanh1102 · 30/8/19

SA_DQ đã viết:
Mình chạy Code của bạn đang dính lỗi này: ReDim dArr(1 To Tong, 1 To Max)
Nếu rà chuột vô tham biếm 'Max' nó đang chứa trị 16.384
Nhưng các trang của bạn không quá 52 cột. Như vậy chúng tỏ macro còn lỗi trong việc xác định số cột trong từng trang tính.
Bạn nên tìm lỗi này & trừ khử đi
Còn nếu đúng trình độ VBA của bạn trung bình thì cách này không cần kiến thức mảng gì sất, tuy chậm hơn nhưng chắc không sai:

B1: Tạo vòng lặp duyệt qua các trang (Bạn đã làm)
B2 Xác dịnh vùng dữ liệu cần chép của trang đang duyệt (Rng)
B3: Copy sang 'Total':
B3.1 Xác định dòng cuối có dữ liệu của 'Total (ví dụ là lRow)
B3.2: Thực hiện Copy vùng dữ liệu cần chép sang 'Total': Rng.Copy Destination:=Sheets("Total")..Cells(lRow,"A")

Bạn đừng nghỉ là mình sẽ viết macro xử lý cho bạn nha: Vì dữ liệu của bạn như thể đống rác như vậy mình không dám đụng đâu!

batman1 đã viết:
Công nhận là máy bạn khủng thật. Tôi chạy code của bạn snow thì không chạy được vì mảng dArr quá lớn. Cũng phải thôi vì mảng dArr có 10329 dòng và 16384 cột, tức có 10329*16384 = 169230336 phần tử. Mà mỗi phần tử ngốn 16 bai (Variant) nên mảng dArr chiếm 2 707 685 376 bai > 2 GB. Trong khi đó 2 máy tôi chỉ có 1 GB và 4 GB RAM, mà một số lớn đã chiếm bởi system và các chương trình mặc định.

Tôi đã nói rõ: Nếu trong mọi sheet dữ liệu không vượt quá cột AV thì ta luôn lấytới AV và không chơi trò Ws.[AV11].End(2).Column nữa. Mà nếu đã chơi trò END thì phải là End(xlToLeft)

Tôi chỉ sửa code của bạn snow để bạn thấy khi mảng giảm cân nhiều thì sẽ thế nào. Còn giải pháp của bạn SA_DQ thì coi như bài tập về nhà cho bạn. Nhưng nếu đúng là "Mình đang tập tọe VBA" thì bài tập quá khó với bạn đấy. Tôi không tin là trên cơ sở mấy gợi ý đó bạn sẽ tự hoàn thành được bài tập đó.

Mã:

Public Sub Noisheet() Dim sArr(), dArr(), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet, tong As Long For Each Ws In ThisWorkbook.Worksheets If Ws.Name <> "Sum" Then If Ws.Name <> "Total" Then tong = tong + Ws.Range("B" & Rows.Count).End(xlUp).Row - 10 End If End If Next If tong = 0 Or tong > Rows.Count Then If tong > Rows.Count Then MsgBox "nhieu dong qua" Exit Sub End If ReDim dArr(1 To tong, 1 To 48) ' lay tu A toi AV = 48 cot For Each Ws In ThisWorkbook.Worksheets If Ws.Name <> "Sum" Then If Ws.Name <> "Total" Then I = Ws.Cells(Rows.Count, "B").End(xlUp).Row If I > 10 Then sArr = Ws.Range("A11:AV" & I).Value For I = 1 To UBound(sArr, 1) K = K + 1 For J = 1 To UBound(sArr, 2) dArr(K, J) = sArr(I, J) Next J Next I End If End If End If Next With Sheets("Total") .Range("A7:AV" & Rows.Count).ClearContents .Range("A7").Resize(K, UBound(dArr, 2)).Value = dArr End With End Sub

Tôi giữ nguyên code của bạn snow nhưng thực ra theo lôgíc thì xóa dữ liệu cũ phải làm ngay từ đầu. Vì sao? Vì nếu để như bây giờ và nếu có tong > Rows.Count thì code sẽ thoát Sub mà không xóa dữ liệu cũ. Người dùng sẽ "tưởng" đó là kết quả mới.

Cảm ơn bạn batman1 đã nhiệt tình hỗ trợ và bạn SA_DQ như mình đã nói mình đang tập tọe VBA mà và đúng là quá khó với mình sau gợi ý của bạn SA_DQ nhưng mình sẽ cố gắng học hỏi thêm. Chúc hai bạn vui khỏe.

VetMini · 30/8/19

batman1 đã viết:
...
Tôi giữ nguyên code của bạn snow nhưng thực ra theo lôgíc thì xóa dữ liệu cũ phải làm ngay từ đầu. Vì sao? Vì nếu để như bây giờ và nếu có tong > Rows.Count thì code sẽ thoát Sub mà không xóa dữ liệu cũ. Người dùng sẽ "tưởng" đó là kết quả mới.

Cái vấn đề này tôi nhắc hoài nhưng hình như bà con ở GPE này không quan tâm.
Nguyên tắc cần thiết của tổng hợp dữ liệu khủng (vài ngàn dòng là khủng rồi) là phải có log ghi lại.
Tối thiểu là phải có lời báo: "Sheet1 12345 dòng; Sheet2 6789 dòng, ...; tổng cộng 123456 dòng"
Nếu là tôi thì hoặc ghi hẳn số dòng ra một file text; hoặc ghi xuất xứ vào cột A (từ dòng 1 đến 12345 là "Sheet1";...) và sau khi kiểm chứng xong, xóa cột.

Nhưng ở đây, tôi thấy tối đa là người ta có một cái message "Done!". Chưa kể nhiều người còn code để gặp vấn đề thì nó vượt qua luôn. Tôi thực sự không hiểu khi chép chỉ 9 sheets mà không biết rằng đáng lẽ phải là 10 thì chép làm cái gì?

batman1 · 30/8/19

Thanh1102 đã viết:
Cảm ơn bạn batman1 đã nhiệt tình hỗ trợ

Nhưng bây giờ tốc độ thế nào?

tuangiang25022008 · 31/8/19

Em có 1 file muốn nhờ các anh chị em trên diễn đàn viết đoạn code tìm điều kiện theo mảng cho em.
Nói ra rất dài dòng nên em có nêu yêu cầu ở trong ảnh và em có đưa file lên rồi.

Mong sớm được anh chị em trên diễn đàn giúp đỡ.
Thân!

Bài đã được tự động gộp: 31/8/19

tuangiang25022008 đã viết:
Em có 1 file muốn nhờ các anh chị em trên diễn đàn viết đoạn code tìm điều kiện theo mảng cho em.
Nói ra rất dài dòng nên em có nêu yêu cầu ở trong ảnh và em có đưa file lên rồi.

Mong sớm được anh chị em trên diễn đàn giúp đỡ.
Thân!

phulien1902 · 31/8/19

tuangiang25022008 đã viết:
Em có 1 file muốn nhờ các anh chị em trên diễn đàn viết đoạn code tìm điều kiện theo mảng cho em.
Nói ra rất dài dòng nên em có nêu yêu cầu ở trong ảnh và em có đưa file lên rồi.

Mong sớm được anh chị em trên diễn đàn giúp đỡ.
Thân!

Bài đã được tự động gộp: 31/8/19

Bạn thử:

PHP:

Sub Test()
    Dim i%, j%, LR&
    LR = ActiveSheet.Range("A10000").End(xlUp).Row
    For i = 4 To LR
        For j = 3 To 11
            If Cells(i, 1) <= Cells(i, j) Then
                Cells(i, 2) = "Lên l" & ChrW(7899) & "p"
                Exit For
            ElseIf Cells(i, 1) > Cells(i, j) Then
                Cells(i, 2) = ChrW(7902) & " l" & ChrW(7841) & "i l" & ChrW(7899) & "p"
            End If
        Next
    Next
End Sub

tuangiang25022008 · 31/8/19

phulien1902 đã viết:

Bạn thử:

PHP:

Sub Test()
    Dim i%, j%, LR&
    LR = ActiveSheet.Range("A10000").End(xlUp).Row
    For i = 4 To LR
        For j = 3 To 11
            If Cells(i, 1) <= Cells(i, j) Then
                Cells(i, 2) = "Lên l" & ChrW(7899) & "p"
                Exit For
            ElseIf Cells(i, 1) > Cells(i, j) Then
                Cells(i, 2) = ChrW(7902) & " l" & ChrW(7841) & "i l" & ChrW(7899) & "p"
            End If
        Next
    Next
End Sub

Cám ơn anh nhiều. Đúng ý của em rồi.
Chúc các anh, chị em sức khỏe và thành đạt.
Thân!

kevinpham1225 · 2/9/19

Xin giúp mình tăng tốc độ xử lý VBA, vì khi nhập 1 dữ liệu tại 1 cell của sheet nguồn, enter nó sẽ mất khoảng 5-7s cho 1 thao tác. File nặng khoảng 12MB.

Cụ thể:
- Sheet nguồn nhập, thay đổi dữ liệu: "2019"
- Sheet lọc dữ liệu từ sheet nguồn: "Ton", "No", "Phat sinh", "Loi nhuan".

Mục đích: tự động Repply filter cho các sheet cần lọc dữ liệu khi nhập hoặc thay đổi giá trị dữ liệu từ Sheet nguồn "2019".

- Đoạn mã (được áp vào module của sheet "2019"):

Private Sub Worksheet_Change(ByVal Target As Range)

Sheets("2019").AutoFilter.ApplyFilter
Sheets("Ton").AutoFilter.ApplyFilter
Sheets("No").AutoFilter.ApplyFilter
Sheets("Phat sinh").AutoFilter.ApplyFilter
Sheets("Loi nhuan").AutoFilter.ApplyFilter

End Sub

Mong các bạn chỉ giúp cách cải thiện tốc độ xử lý; Hoặc viết giúp đoạn code nào xử lý nhanh với mục đích tự động Repply Filter tại các sheet cần lọc khi thay đổi dữ liệu từ sheet nguồn.
Cảm ơn !

VetMini · 2/9/19

Lại cái tật một bài đăng hai chỗ.
Thành viên hơn 5 năm gì mà chả biết lịch sự căn bản.

Duc Phuc · 4/9/19

Hi anh chị, em mới tìm hiểu về VBA, nên chưa có nhiều kinh nghiệm, mong các anh chị chỉ bảo.
Em đang có 1 bài tập như trong file.
Hiện e không biết sử dụng vòng lặp VBA như thế nào để thực hiện.
Hiện e có thể sử dụng hàm thủ công sumif và countif .
Yêu cầu:
Tính số ngày hàng về ( lots ) và tổng số lượng hàng về ( pcs )

Cảm ơn anh chị !

phulien1902 · 4/9/19

Duc Phuc đã viết:
Hi anh chị, em mới tìm hiểu về VBA, nên chưa có nhiều kinh nghiệm, mong các anh chị chỉ bảo.
Em đang có 1 bài tập như trong file.
Hiện e không biết sử dụng vòng lặp VBA như thế nào để thực hiện.
Hiện e có thể sử dụng hàm thủ công sumif và countif .
Yêu cầu:
Tính số ngày hàng về ( lots ) và tổng số lượng hàng về ( pcs )

Cảm ơn anh chị !

1 cách:

PHP:

Sub Test()
    Dim LR As Long
    LR = Range("B" & Rows.Count).End(xlUp).Row
    [L3] = WorksheetFunction.CountIf(Range("C3:C" & LR), Range("K3"))
    [M3] = WorksheetFunction.SumIf(Range("C3:C" & LR), Range("K3"), Range("D3:D" & LR))
End Sub

Duc Phuc · 4/9/19

phulien1902 đã viết:

1 cách:

PHP:

Sub Test()
    Dim LR As Long
    LR = Range("B" & Rows.Count).End(xlUp).Row
    [L3] = WorksheetFunction.CountIf(Range("C3:C" & LR), Range("K3"))
    [M3] = WorksheetFunction.SumIf(Range("C3:C" & LR), Range("K3"), Range("D3:D" & LR))
End Sub

OK tks a . Để e tìm hiểu thêm .

LYSM · 4/9/19

Em chào các anh chị!
Em có code lấy dữ liệu từ 1 workbook khác như bên dưới, nhưng khi vận hành nếu sarr(1,j) (j =25 to 28) có số ký tự >255 thì nó chỉ lấy đến 255 ký tự thôi ạ, cụ thể là file "An" trong cell B26 sẽ bị bỏ bớt nội dung khi sang file "z File Tong hop". Mong các anh chị giúp đỡ ạ, code này em đi xin bác snow25 nên không hiểu bản chất. Em cám ơn!

Mã:

Sub tonghop()

     Application.ScreenUpdating = False

     Application.AskToUpdateLinks = False

     Application.DisplayAlerts = False

     Dim cn As Object, sqlStr As String, i As Long, lr As Long, k, rst As Object, Pro As String, ext As String, arr(1 To 1000, 1 To 14), a As Long

     Dim sarr, j As Long

     Set cn = CreateObject("ADODB.Connection")

     Set rst = CreateObject("ADODB.recordset")

     With Application.FileDialog(msoFileDialogFilePicker)

         .AllowMultiSelect = True

    If Not .Show = -1 Then Exit Sub

    For Each k In .SelectedItems

       Pro = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="

       ext = ";Extended Properties=""Excel 12.0;HDR=yes;IMEX= 1"";"

       cn.Open (Pro & k & ext)

       sqlStr = "Select * From [sheet1$a1:e30]"

       sarr = cn.Execute(sqlStr).GetRows

       a = a + 1

       arr(a, 1) = a

       arr(a, 2) = sarr(1, 3)

       arr(a, 3) = sarr(1, 0)

       arr(a, 4) = sarr(1, 2)

       arr(a, 5) = sarr(1, 1)

       arr(a, 9) = sarr(4, 7)

       arr(a, 10) = sarr(4, 8)

       arr(a, 11) = sarr(4, 9)

       arr(a, 12) = sarr(4, 10)

       arr(a, 13) = sarr(4, 11)

       arr(a, 14) = sarr(1, 24)

       For j = 25 To 28

          If sarr(1, j) <> Empty Then arr(a, 14) = arr(a, 14) & Chr(10) & sarr(1, j)

       Next j

       cn.Close

    Next

    End With

    With Sheets("sheet1")

         lr = .Range("A" & Rows.Count).End(xlUp).Row

         If lr > 12 Then .Range("A13:N" & lr).ClearContents

         If a Then .Range("A13:N13").Resize(a).Value = arr

     End With

End Sub

Duc Phuc · 8/9/19

Cảm ơn anh chị đã giải đáp bài tập hôm bữa, Nay em lại xin nhờ anh chị giải đáp tiếp 1 bài tập như sau. Bài tập này bổ sung bài tập trước.

Yêu cầu: Đếm xem từng vật liệu có bao nhiêu ngày về trong tháng và tổng lượng hàng về trong tháng. ( có ngày về 2 lần, nên sẽ trùng ngày )

VetMini · 8/9/19

Đây là thớt "thắc mắc về code". Giành cho những người viết code và cần được chỉ dẫn chỗ bí hoặc thắc mắc.

Bài tập cần làm giùm thì đem qua thớt "thành viên giúp nhau" mà nhờ.

Duc Phuc · 8/9/19

VetMini đã viết:
Đây là thớt "thắc mắc về code". Giành cho những người viết code và cần được chỉ dẫn chỗ bí hoặc thắc mắc.

Bài tập cần làm giùm thì đem qua thớt "thành viên giúp nhau" mà nhờ.

Ok a .

25xuanquang · 26/9/19

Các cụ cho em hỏi dòng code này sai ở đâu ạ

Sheet1.Range("G2").Formula = "=E2= Sheet4.Range("B1")"

Nếu em để dạng tex thì như này lại đúng:
Sheet1.Range("G2").Formula = "=E2="""& Sheet4.Range("B1") & """"

Code full đây ạ T___T
Sub Search_BDS()

Sheet4.Range("A3:F1000").Clear
Sheet1.Range("G2").Formula = "=E2= Sheet4.Range("B1")"
Sheet1.Range("A1:F67010").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheet1.Range("G1:G2"), CopyToRange:=Sheet4.Range("A3"), _
Unique:=False
End Sub

snow25 · 26/9/19

25xuanquang đã viết:
Các cụ cho em hỏi dòng code này sai ở đâu ạ
Sheet1.Range("G2").Formula = "=E2= Sheet4.Range("B1")"

Nếu em để dạng tex thì như này lại đúng:
Sheet1.Range("G2").Formula = "=E2="""& Sheet4.Range("B1") & """"

Code full đây ạ T___T
Sub Search_BDS()

Sheet4.Range("A3:F1000").Clear
Sheet1.Range("G2").Formula = "=E2= Sheet4.Range("B1")"
Sheet1.Range("A1:F67010").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheet1.Range("G1:G2"), CopyToRange:=Sheet4.Range("A3"), _
Unique:=False
End Sub

Bạn chạy debug 2 câu lệnh xem nó có gì khác nhau là biết.

Chuyên đề giải đáp những thắc mắc về code VBA

Thành viên thường trực

/(hông là gì!

Thành viên mới

Thành viên gạo cội

Thành viên hoạt động

Ăn cùng góc phố

Thành viên gạo cội

Thành viên mới

File đính kèm

GPE - My love

File đính kèm

Thành viên mới

Thành viên mới

Ăn cùng góc phố

Thành viên mới

File đính kèm

GPE - My love

Thành viên mới

Thành viên thường trực

File đính kèm

Thành viên mới

File đính kèm

Ăn cùng góc phố

Thành viên mới

Thành viên mới

Thành viên gạo cội