Chuyên mục xử lý, gỡ rối code VBA

[ndu96081631]

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

 

[Miccpro]

Tăng tốc thì mình đọc bài sau xem...

If Min > 42004 And Max < 44196 Then
    If Min <= Max Then
      Min = CLng(Min): Max = CLng(Max)
        Dim a(), i As Long
        ReDim a(1 To Max - Min + 1, 1 To 1)
        For dem = Min To Max
            i = i + 1
            a(i, 1) = dem
        Next
        .Cells(1, 2).Resize(UBound(a, 1), 1) = a
    End If
End If

Đã áp dụng được cái của bác befaint, cảm ơn bác nhiều, sau khi đọc link dẫn của bác về mảng thì có vấn đề này tôi chưa làm được . Đang chập chững mày mò mà làm mãi không được. Mong các anh chị em giúp đỡ, xin cảm ơn

 

[PacificPR]

Đã áp dụng được cái của bác befaint, cảm ơn bác nhiều, sau khi đọc link dẫn của bác về mảng thì có vấn đề này tôi chưa làm được . Đang chập chững mày mò mà làm mãi không được. Mong các anh chị em giúp đỡ, xin cảm ơn

Bạn chạy thử Code này xem sao

Sub Miccpro()
    Dim Dic As Object, sArr(), dArr(1 To 65535, 1 To 2)
    Dim I As Long, J As Date, K As Long, R As Long
    Dim Rng As Range, Nmin As Date, Nmax As Date
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    Set Rng = .Range("B2", .Range("B65535").End(3)).Resize(, 2)
    Nmin = Application.Min(Rng): Nmax = Application.Max(Rng)
End With
sArr = Rng.Value2
For I = 1 To UBound(sArr)
    For J = sArr(I, 1) To sArr(I, 2)
        Dic.Item(J) = 1
    Next J
Next I
For I = Nmin To Nmax
    K = K + 1
    dArr(K, 1) = I
    R = Dic.Item(I)
    If R = 0 Then dArr(K, 2) = "Ngh" & ChrW$(7881)
Next I
With Sheet2
    Range("B2").Resize(K, 2) = dArr
End With
Set Dic = Nothing
End Sub

 

[befaint]

anh chị em

Mình xưng hô xã giao thì gọi là anh/ chị có được không?
Cho dù biết rõ người đối thoại với mình nhỏ tuổi hơn mình cả chục tuổi đi nữa, mình gọi là anh/ chị xem có bị thiệt miếng thịt nào không?
------

Sub bebe()
    Dim a(), arr(), b(), N As Long, Res(), D As Long
    Dim i As Long, k As Long
    a = Sheet1.Range("B2:C6").Value2
    b = Sheet2.Range("B2:B15").Value2
    N = UBound(b, 1)
    ReDim Res(1 To N, 1 To 1)
    For i = 1 To UBound(a, 1)
        If a(i, 1) <= a(i, 2) Then
            For D = a(i, 1) To a(i, 2)
                k = k + 1
                ReDim Preserve arr(1 To k)
                arr(k) = D
            Next D
        End If
    Next i
    For i = 1 To N
        If IsError(Application.Match(b(i, 1), arr, 0)) = True Then Res(i, 1) = "Ngh" & ChrW(7881)
    Next i
    Sheet2.Range("C2").Resize(N, 1) = Res
End Sub

 

[SA_DQ]

Giả dụ bjo em muốn gán nó vào cái hình oval có tên là tính biến động để sau chỉ ấn vào đó là nó ra kết quả thì làm thế nào ạ? Em mới chỉ biết gán macro thôi ạ. Các bác làm ơn chỉ em với ạ.
. . . . Thế chỗ em hỏi thì sao anh? có cách nào gán đoạn công thức "=chenhlech(I12;I13;I14;I15)" vào hình kia để ấn vô thì nó thực thi không anh

Bạn đã biết "gán" macro vô hình; Giờ thay nội dung đó lại là được;
Ví dụ

 Sub GPE  
  [I16].Value= ChenhLech([I12], [I13], [I14], [I15])
End Sub

 

[VetMini]

@VetMini ; @SA_DQ ; @Hoang2013 cảm ơn các bác đã reply, em đã sửa được rồi. em làm function và nó cho ra kết quả rồi.
...
Giả dụ bjo em muốn gán nó vào cái hình oval có tên là tính biến động để sau chỉ ấn vào đó là nó ra kết quả thì làm thế nào ạ? Em mới chỉ biết gán macro thôi ạ. Các bác làm ơn chỉ em với ạ. Em cảm ơn nhiều

Thứ nhất, tôi không tiếp xúc theo kiểu vừa tiếng Việt vừa tiếng Anh. Nếu bạn dốt tiếng Việt thì cứ dùng tiếng Anh thuần túy, tôi đủ khả năng hầu tiếp (nhưng nếu trường hợp này mà bạn cho thấy dốt cả tiếng Anh thì tôi mạt sát ngay)

Thứ hai, tôi đã cảnh báo về vấn đề viết tắt. Tôi chỉ khuyến khích người hiếu học. Đối với tôi, người hiếu học khong có thói quen viết tắt.

(*) Chớ có bắt chước theo lời nhơn vật nọ lý luận rằng thời buổi bây giờ phải tập dùng tiếng Anh cho quen. Lý luận như vậy là ngụy biện. Nói thẳng ra đây tôi là người song ngữ, tiếng Anh tôi dùng không khác gì tiếng Việt. Nhưng trong suốt quá trình học, tôi không bao giờ lẫn lộn 2 cái vào nhau,

 

[acmen87]

Thứ nhất, tôi không tiếp xúc theo kiểu vừa tiếng Việt vừa tiếng Anh. Nếu bạn dốt tiếng Việt thì cứ dùng tiếng Anh thuần túy, tôi đủ khả năng hầu tiếp (nhưng nếu trường hợp này mà bạn cho thấy dốt cả tiếng Anh thì tôi mạt sát ngay)

Thứ hai, tôi đã cảnh báo về vấn đề viết tắt. Tôi chỉ khuyến khích người hiếu học. Đối với tôi, người hiếu học khong có thói quen viết tắt.

(*) Chớ có bắt chước theo lời nhơn vật nọ lý luận rằng thời buổi bây giờ phải tập dùng tiếng Anh cho quen. Lý luận như vậy là ngụy biện. Nói thẳng ra đây tôi là người song ngữ, tiếng Anh tôi dùng không khác gì tiếng Việt. Nhưng trong suốt quá trình học, tôi không bao giờ lẫn lộn 2 cái vào nhau,

Híc, cảm ơn bác góp ý. E sẽ rút kinh nghiệm

 

[bibim2014]

 

[Miccpro]

Mình xưng hô xã giao thì gọi là anh/ chị có được không?
Cho dù biết rõ người đối thoại với mình nhỏ tuổi hơn mình cả chục tuổi đi nữa, mình gọi là anh/ chị xem có bị thiệt miếng thịt nào không?
------

Sub bebe()
    Dim a(), arr(), b(), N As Long, Res(), D As Long
    Dim i As Long, k As Long
    a = Sheet1.Range("B2:C6").Value2
    b = Sheet2.Range("B2:B15").Value2
    N = UBound(b, 1)
    ReDim Res(1 To N, 1 To 1)
    For i = 1 To UBound(a, 1)
        If a(i, 1) <= a(i, 2) Then
            For D = a(i, 1) To a(i, 2)
                k = k + 1
                ReDim Preserve arr(1 To k)
                arr(k) = D
            Next D
        End If
    Next i
    For i = 1 To N
        If IsError(Application.Match(b(i, 1), arr, 0)) = True Then Res(i, 1) = "Ngh" & ChrW(7881)
    Next i
    Sheet2.Range("C2").Resize(N, 1) = Res
End Sub

Cảm ơn bác đã nhắc nhở, em sẽ rút kinh nghiệm.
Em xin hỏi bấc vấn đề này:

    a = Sheet1.Range("B2:C6").Value2
    b = Sheet2.Range("B2:B15").Value2

Giả sử em thay Sheet1.Range("B2:C6").Value2 thành Sheet1.Range("B2:C5000").Value2 chẳng hạn thì nó chạy rất chậm bác ạ. Có cách gì nhanh hơn không? Mong các bác giúp đỡ

 

[befaint]

nó chạy rất chậm

Bạn gửi cả CỤM nó lên đây xem thì mới biết tại sao chậm...

 

[Miccpro]

Bạn gửi cả CỤM nó lên đây xem thì mới biết tại sao chậm...

Tức là khi em gán giá trị a khoảng rộng hơn, từ a = Sheet1.Range("B2:C6").Value2 thành a = Sheet1.Range("B2:C5000").Value2 thì code chạy tương đối chậm bác ạ,
Giả sử em thay thế này chẳng hạn

Sub bebe()
    Dim a(), arr(), b(), N As Long, Res(), D As Long
    Dim i As Long, k As Long
    a = Sheet1.Range("B2:C10000").Value2
    b = Sheet2.Range("B2:B65000").Value2
    N = UBound(b, 1)
    ReDim Res(1 To N, 1 To 1)
    For i = 1 To UBound(a, 1)
        If a(i, 1) <= a(i, 2) Then
            For D = a(i, 1) To a(i, 2)
                k = k + 1
                ReDim Preserve arr(1 To k)
                arr(k) = D
            Next D
        End If
    Next i
    For i = 1 To N
        If IsError(Application.Match(b(i, 1), arr, 0)) = True Then Res(i, 1) = "Ngh" & ChrW(7881)
    Next i
    Sheet2.Range("C2").Resize(N, 1) = Res
End Sub

 

[hpkhuong]

Tức là khi em gán giá trị a khoảng rộng hơn, từ a = Sheet1.Range("B2:C6").Value2 thành a = Sheet1.Range("B2:C5000").Value2 thì code chạy tương đối chậm bác ạ,

Dữ liệu ít -> tới nhiều thì chậm hơn là đúng rồi.
Mà với mảng có 5000 dòng mà chậm thì là vô lý.
Chậm do nhiều nguyên nhân, dữ liệu trên file bạn, format trên file bạn...: có biết file bạn như nào đâu mà phán....

 

[Miccpro]

Dữ liệu ít -> tới nhiều thì chậm hơn là đúng rồi.
Mà với mảng có 5000 dòng mà chậm thì là vô lý.
Chậm do nhiều nguyên nhân, dữ liệu trên file bạn, format trên file bạn...: có biết file bạn như nào đâu mà phán....

File của em đây bác, khi em thay a = Sheet1.Range("B2:C6").Value2 thành a = Sheet1.Range("B2:C5000").Value2 chẳng hạn thì nó chạy tương đối chậm ạ

 

[befaint]

File của em đây bác, khi em thay a = Sheet1.Range("B2:C6").Value2 thành a = Sheet1.Range("B2:C5000").Value2 chẳng hạn thì nó chạy tương đối chậm ạ

Trong file bạn gửi có tí dữ liệu nào tới dòng 5000 nào đâu?
Định tét code chơi cho vui hả?
b = Sheet2.Range("B2:B10000").Value2
Có biết 10,000 dòng là bao nhiêu năm không? Giả sử không bỏ sót ngày nào thì ứng với > 27 năm đó. Không biết công ty có sống thọ tới lúc đó không?

Chạy thử thấy chậm bình thường, chẳng làm sao cả.

 

[Miccpro]

Trong file bạn gửi có tí dữ liệu nào tới dòng 5000 nào đâu?
Định tét code chơi cho vui hả?
b = Sheet2.Range("B2:B10000").Value2
Có biết 10,000 dòng là bao nhiêu năm không? Giả sử không bỏ sót ngày nào thì ứng với > 27 năm đó. Không biết công ty có sống thọ tới lúc đó không?

Chạy thử thấy chậm bình thường, chẳng làm sao cả.

Vâng, thực tế là như bác nói. Em cũng có ý test ạ. Mà bác ơi; cái Value với Value2 nó khác nhau chỗ nào ạ, em tìm đọc trên mạng mà chưa hiểu lắm, bác cho em cái link được không? Cảm ơn bác

 

[VetMini]

Cái chỗ chậm là tại vì thuật toán quá tệ.
Đầu tiên, nó tuỳ theo con số k cuối cùng. Cứ mỗi lần k tăng lên 1 là lại phải Redim Preserve cái mảng.
Kế đó, là cái vòng lặp 1 tới N (N = 65000). Bên trong vòng lặp này gọi hàm Match với tham số thứ 3 là 0, dò mệt nghỉ.
Cứ tưởng tượng k = 1000, hàm match sẽ dò trung bình 1000/2 = 500 trị một lượt. 65000 lượt là ...

 

[Miccpro]

Cái chỗ chậm là tại vì thuật toán quá tệ.
Đầu tiên, nó tuỳ theo con số k cuối cùng. Cứ mỗi lần k tăng lên 1 là lại phải Redim Preserve cái mảng.
Kế đó, là cái vòng lặp 1 tới N (N = 65000). Bên trong vòng lặp này gọi hàm Match với tham số thứ 3 là 0, dò mệt nghỉ.
Cứ tưởng tượng k = 1000, hàm match sẽ dò trung bình 1000/2 = 500 trị một lượt. 65000 lượt là ...

Bác edit dùm cái được không ạ. Xin cảm ơn

 

[VetMini]

Bác edit dùm cái được không ạ. Xin cảm ơn

Bài viết của tôi phạm quy diễn đàn chỗ nào mà bạn buộc tôi phải ê đít ?

 

[duytmd]

Nhờ các bác sửa chữa lỗi giúp e. lỗi click vào cột a của sheet test không hiện lên bảng userform
link: https://www.dropbox.com/s/sx0t28oed9692hk/VD.lnk?dl=0
hoặc

 

[befaint]

lỗi

Thử bỏ dòng: CBDMHH.Value = "ALL"

 

[duytmd]

Ok. Cám ớn bác nhé, đã sửa dược lỗi nhưng lại phát sinh lỗi không tra cứu được hàng hóa.