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

[maytinhvp01]

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]

 

[luckylucke_2009]

Số dòng có dữ liệu trong vùng chọn

Nhờ ACE điều chỉnh giúp đoạn code này:

Sub SO_DONG_CO_DU_LIEU()
Dim so_DONG As Long
so_DONG = Selection.Rows.Count
MsgBox so_DONG
End Sub


Mục đích là chỉ xác định số dòng có chứa dữ liệu trong vùng chọn;
"Selection.Rows.Count" số dòng = tất cả các dòng trong vùng chọn;
Nhưng nếu thay bằng Counta thì sẽ báo lỗi

Cám ơn!

 

[luckylucke_2009]

Hi...hi sửa được rùi!

Sub SO_DONG_CO_DU_LIEU()
Dim so_DONG As Long
'
so_DONG = Application.CountA(Selection)
MsgBox "So dong co du lieu trong vung chon la: " & so_DONG
End Sub

 

[befaint]

Sub SO_DONG_CO_DU_LIEU()
Dim so_DONG As Long
'
so_DONG = Application.CountA(Selection)
MsgBox "So dong co du lieu trong vung chon la: " & so_DONG
End Sub

Nếu vùng chọn có nhiều hơn 1 cột và trong một dòng có nhiều hơn 1 ô có dữ liệu thì làm sao?

 

[luckylucke_2009]

Nếu vùng chọn có nhiều hơn 1 cột và trong một dòng có nhiều hơn 1 ô có dữ liệu thì làm sao?

Cám ơn nhắc nhở 2 lỗi kể trên. Điều chỉnh thế này bạn nhé:

Sub SO_DONG_CO_DU_LIEU()
Dim so_DONG As Long
'
so_DONG = Application.CountA(Selection.Rows)
MsgBox "So dong co du lieu trong vung chon la: " & so_DONG
End Sub

 

[befaint]

Cám ơn nhắc nhở 2 lỗi kể trên. Điều chỉnh thế này bạn nhé:

Sub SO_DONG_CO_DU_LIEU()
Dim so_DONG As Long
'
so_DONG = Application.CountA(Selection.Rows)
MsgBox "So dong co du lieu trong vung chon la: " & so_DONG
End Sub

Không có đúng...

Muốn được hỗ trợ nhanh thì gửi file excel lên, miêu tả cụ thể mục đích cuối cùng làm gì?

 

[VetMini]

Nếu vùng chọn có nhiều hơn 1 cột và trong một dòng có nhiều hơn 1 ô có dữ liệu thì làm sao?

Thì khi gặp "số dòng có dữ liệu" lớn hơn số dòng của range, cười trừ chứ làm sao?

 

[prince2015]

Chào các anh chị,

Em là thành viên mới của diễn đàn và đang tập viết code VBA. Xin anh chị giúp đỡ em tìm lỗi sai trong code sau:
- Em muốn copy tất cả giá trị của column A sang column B trong tất cả các sheets của workbook (hoặc sheets tùy chọn) với code sau:

Sub CopyColumn()
Application.DisplayAlerts = False
Dim WsSheet As Worksheet
For Each WsSheet In ThisWorkbook.Worksheets
Range("A1:A500").Copy Destination:=Range("B1:B500")
Next WsSheet
Application.DisplayAlerts = True
End Sub

Nhưng khi em chạy code thì chỉ có thể chạy trong 1 sheet chứ không thể chạy cho all sheets được. Mong anh chị giúp đỡ
Em cám ơn ạ

 

[HieuCD]

Chào các anh chị,
Em là thành viên mới của diễn đàn và đang tập viết code VBA. Xin anh chị giúp đỡ em tìm lỗi sai trong code sau:
- Em muốn copy tất cả giá trị của column A sang column B trong tất cả các sheets của workbook (hoặc sheets tùy chọn) với code sau:
Nhưng khi em chạy code thì chỉ có thể chạy trong 1 sheet chứ không thể chạy cho all sheets được. Mong anh chị giúp đỡ
Em cám ơn ạ

bạn phải chỉ định tên sheet

WsSheet.Range("A1:A500").Copy Destination:=WsSheet.Range("B1:B500")

 

[prince2015]

bạn phải chỉ định tên sheet

WsSheet.Range("A1:A500").Copy Destination:=WsSheet.Range("B1:B500")

Em làm được rồi. Cám ơn anh đã giúp đỡ

 

[ndhmoney686]

Em đang chuyển từ công thức sang code. Và muốn test thử xem code có đúng kết quả như công thức ko. Em đang code sự kiện (Em nháy đúp vào từng ô của cột thì kết quả Ok. Nhưng như vậy mà ngồi nháy mấy ngàn ô của dòng thì hỏng chuột mất

Ví dụ e có vùng sau:
Range("I10:I2000").Select -> bây giờ thêm câu lệnh gì để toàn bộ vùng đó được tác động giống như nhấn F2

Mong A/C chỉ giúp. Cám ơn A/C nhiều!

 

[ndhmoney686]

Em muốn nhờ A/c viết giúp Em code sự kiện, tính tồn cho cột G. Khi các ô trong vùng nhập, xuất (C13:E1000) có sự thay đổi.

Với điều kiện nếu ô ở cột A là "ĐK" tức "tồn đầu kỳ" và ô cột A không có dữ liệu thì không thực hiện. Còn lại chạy Code với cách tính tồn như sau:

=IF(AND($A14<>"ĐK",$A14>0),($G13+$C14+$D14)-($E14+$F14),0)

Mong A/C giúp đỡ Em. Cám ơn A/C !

 

[phulien1902]

Em muốn nhờ A/c viết giúp Em code sự kiện, tính tồn cho cột G. Khi các ô trong vùng nhập, xuất (C13:E1000) có sự thay đổi.

Với điều kiện nếu ô ở cột A là "ĐK" tức "tồn đầu kỳ" và ô cột A không có dữ liệu thì không thực hiện. Còn lại chạy Code với cách tính tồn như sau:

=IF(AND($A14<>"ĐK",$A14>0),($G13+$C14+$D14)-($E14+$F14),0)

Mong A/C giúp đỡ Em. Cám ơn A/C !

Bạn tham khảo:

Sub abc()
Dim i%
For i = 13 To 40
If Cells(i, 1) = Empty Then Cells(i, 7) = "-"
If Cells(i, 1) <> "?K" And Cells(i, 1) <> Empty Then
Cells(i + 1, 7) = Cells(i, 7) + Cells(i + 1, 3) + Cells(i + 1, 4) - Cells(i + 1, 5) - Cells(i + 1, 6)
End If
Next
End Sub

 

[ndhmoney686]

Bạn tham khảo:

Sub abc()
Dim i%
For i = 13 To 40
If Cells(i, 1) = Empty Then Cells(i, 7) = "-"
If Cells(i, 1) <> "?K" And Cells(i, 1) <> Empty Then
Cells(i + 1, 7) = Cells(i, 7) + Cells(i + 1, 3) + Cells(i + 1, 4) - Cells(i + 1, 5) - Cells(i + 1, 6)
End If
Next
End Sub

Cám ơn bạn phulien1902! Kết quả chạy rất Ok bạn ạ. Nếu muốn chuyển sang dạng code sự kiện thì cần phải sửa code như thế nào Bạn nhỉ. mong Bạn chỉ giúp

 

[phulien1902]

Cám ơn bạn phulien1902! Kết quả chạy rất Ok bạn ạ. Nếu muốn chuyển sang dạng code sự kiện thì cần phải sửa code như thế nào Bạn nhỉ. mong Bạn chỉ giúp

Bạn thử thế này xem:

Private Sub Worksheet_Change(ByVal Target As Range)
         If Not Intersect(Target, Range("C3:F40")) Is Nothing Then
             abc
         End If
End Sub

 

[ndhmoney686]

Bạn thử thế này xem:

Private Sub Worksheet_Change(ByVal Target As Range)
         If Not Intersect(Target, Range("C3:F40")) Is Nothing Then
             abc
         End If
End Sub

Mình thử để code như thế này.

Private Sub Worksheet_Change(ByVal Target As Range)         
         If Not Intersect(Target, Range("C3:F40")) Is Nothing Then
             abc
         End If
End Sub

-------------------------------------------
Sub abc()
Dim i%
For i = 13 To 40
If Cells(i, 1) = Empty Then Cells(i, 7) = "-"
If Cells(i, 1) <> "?K" And Cells(i, 1) <> Empty Then
Cells(i + 1, 7) = Cells(i, 7) + Cells(i + 1, 3) + Cells(i + 1, 4) - Cells(i + 1, 5) - Cells(i + 1, 6)
End If
Next
End Sub

Nhưng khi bấm vào 1 ô trong phần nhập xuất thì nó chạy tất cả luôn kết quả luôn. Không phải là dòng nào có sự thay đổi thì mới cập nhập lại số liệu. Bạn và A/C xem giúp Em với ạ.

 

[ndhmoney686]

Thay toàn bộ bằng code này xem

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range, R As Long
If Not Intersect(Target, Range("C13:F40")) Is Nothing Then
    For Each Cll In Target
    R = Cll.Row
        If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then
            Cells(R, 7) = Cells(R, 3) + Cells(R, 4) - Cells(R, 5) - Cells(R, 6) + Cells(R - 1, 7)
        End If
    Next
End If
End Sub

Cám ơn Anh hpkhuong và bạn phulien1902 đã giúp đỡ Em rất nhiều! Em cho code vào test thử Ok rồi ạ. Em đang chập chững nghiên cứu code Mong A/C chỉ bảo Em nhiều ạ

Hiện tại Em đang có 2 code đều chạy dạng Sự kiện.
- Một cái là tính chi phí lưu kho, bốc xếp...
- Một cái là tính tồn kho.
Đầu tiên em để 2 cái đều có Private Sub Worksheet_Change(ByVal Target As Range) thì nó báo lỗi vậy là chắc ko thể để 2 cái sự kiện riêng biệt. Mà phải lồng các dòng lệnh vào với nhau thì phải.
Em ngồi lồng thử code vào với nhau thì thấy nó chạy cho kết quả đúng. Nhưng ko biết như vậy có hợp lý và tối ưu chưa. Mong A/C chỉ bảo giúp Em. Cám ơn A/C nhiều.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rws As Long, Tmp As Double, DG As Double 'Khai bao bien cua code 1
 Dim Cll As Range, R As Long                  'Khai bao bien cua code 2
 '-----------------------------------------------------------------------------------------------
 'Code 1 : Tinh chi phi luu kho, boc xep...
 Rws = [B13].CurrentRegion.Rows.Count + 2000
 If Not Intersect(Target, [I13].Resize(Rws + 2000)) Is Nothing Then
    With Target
        DG = .Value
        If .Offset(, -1).Value > 0 Then
            .Offset(, 1).Resize(, 2).Value = 0
        Else
            .Offset(, 1).Value = (.Offset(, -5).Value + .Offset(, -4).Value) * DG / 2
            Tmp = (.Offset(, -6).Value + .Offset(, -5).Value) * DG
            If Tmp > 0 Then
                .Offset(, 2).Value = .Offset(, -6).Value * DG
            Else
                .Offset(, 2).Value = (.Offset(, -3).Value + .Offset(, -2).Value) * DG
            End If
        End If
    End With
 ElseIf Not Intersect(Target, [M13].Resize(Rws + 2000)) Is Nothing Then    '*'
    GPE Target
 ElseIf Not Intersect(Target, [P13].Resize(Rws + 2000)) Is Nothing Then
    GPE Target
 ElseIf Not Intersect(Target, [S13].Resize(Rws + 2000)) Is Nothing Then
    GPE Target                                                          '*'
 End If
 '-------------------------------------------------------------------------------------------------
 'Code 2 : Tinh ton kho
 If Not Intersect(Target, Range("C13:F40")) Is Nothing Then
    For Each Cll In Target
    R = Cll.Row
        If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then
            Cells(R, 7) = Cells(R, 3) + Cells(R, 4) - Cells(R, 5) - Cells(R, 6) + Cells(R - 1, 7)
        End If
    Next
  End If
 
 End Sub
Sub GPE(Targ As Range)                                      '*'
    With Targ
        .Offset(, 1).Value = .Offset(, -1).Value * .Value
    End With
End Sub

 

[Gió Đông]

Cám ơn Anh hpkhuong và bạn phulien1902 đã giúp đỡ Em rất nhiều! Em cho code vào test thử Ok rồi ạ. Em đang chập chững nghiên cứu code Mong A/C chỉ bảo Em nhiều ạ

Hiện tại Em đang có 2 code đều chạy dạng Sự kiện.
- Một cái là tính chi phí lưu kho, bốc xếp...
- Một cái là tính tồn kho.
Đầu tiên em để 2 cái đều có Private Sub Worksheet_Change(ByVal Target As Range) thì nó báo lỗi vậy là chắc ko thể để 2 cái sự kiện riêng biệt. Mà phải lồng các dòng lệnh vào với nhau thì phải.
Em ngồi lồng thử code vào với nhau thì thấy nó chạy cho kết quả đúng. Nhưng ko biết như vậy có hợp lý và tối ưu chưa. Mong A/C chỉ bảo giúp Em. Cám ơn A/C nhiều.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rws As Long, Tmp As Double, DG As Double 'Khai bao bien cua code 1
 Dim Cll As Range, R As Long                  'Khai bao bien cua code 2
 '-----------------------------------------------------------------------------------------------
 'Code 1 : Tinh chi phi luu kho, boc xep...
 Rws = [B13].CurrentRegion.Rows.Count + 2000
 If Not Intersect(Target, [I13].Resize(Rws + 2000)) Is Nothing Then
    With Target
        DG = .Value
        If .Offset(, -1).Value > 0 Then
            .Offset(, 1).Resize(, 2).Value = 0
        Else
            .Offset(, 1).Value = (.Offset(, -5).Value + .Offset(, -4).Value) * DG / 2
            Tmp = (.Offset(, -6).Value + .Offset(, -5).Value) * DG
            If Tmp > 0 Then
                .Offset(, 2).Value = .Offset(, -6).Value * DG
            Else
                .Offset(, 2).Value = (.Offset(, -3).Value + .Offset(, -2).Value) * DG
            End If
        End If
    End With
 ElseIf Not Intersect(Target, [M13].Resize(Rws + 2000)) Is Nothing Then    '*'
    GPE Target
 ElseIf Not Intersect(Target, [P13].Resize(Rws + 2000)) Is Nothing Then
    GPE Target
 ElseIf Not Intersect(Target, [S13].Resize(Rws + 2000)) Is Nothing Then
    GPE Target                                                          '*'
 End If
 '-------------------------------------------------------------------------------------------------
 'Code 2 : Tinh ton kho
 If Not Intersect(Target, Range("C13:F40")) Is Nothing Then
    For Each Cll In Target
    R = Cll.Row
        If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then
            Cells(R, 7) = Cells(R, 3) + Cells(R, 4) - Cells(R, 5) - Cells(R, 6) + Cells(R - 1, 7)
        End If
    Next
  End If
 
 End Sub
Sub GPE(Targ As Range)                                      '*'
    With Targ
        .Offset(, 1).Value = .Offset(, -1).Value * .Value
    End With
End Sub

Xem qua, thì thấy:
Cũng tạm được thôi, tuy thế code trên liên quán đến gán kết quả xuống ô nhiều (tức là có change trong cells đó --> gọi đến sự kiện Worksheet_Change) nên bạn lưu ý đến việc bật tắt sự kiện sau:

Application.EnableEvents=False '(tắt)
....
Application.EnableEvents=true '(mở)

bạn nên hiểu kỹ bằng cách tìm từ khóa dòng lệnh trên diễn đàn, trước khi cho vào ứng dụng

 

[VetMini]

Xem qua, thì thấy:
Cũng tạm được thôi, tuy thế code trên liên quán đến gán kết quả xuống ô nhiều (tức là có change trong cells đó --> gọi đến sự kiện Worksheet_Change) nên bạn lưu ý đến việc bật tắt sự kiện sau:

Application.EnableEvents=False '(tắt)
....
Application.EnableEvents=true '(mở)

bạn nên hiểu kỹ bằng cách tìm từ khóa dòng lệnh trên diễn đàn, trước khi cho vào ứng dụng

Việc dùng code để bật tắt này nọ làm kiểu như vậy chỉ an toàn khi có 1 sub. Nếu ó nhiều hơn 1, tức à có khả năng sub này gọi sub kia thì phải cẩn thận. Điều này tôi đã từng khuyến cáo 1 vài lần rồi.
Ví dụ: sub A có 2 lệnh trên. Sub A gọi sub B. Sub B cũng có 2 lệnh trên. Như vậy, Application.EnableEvents được B gán trở lại thành true trước khi A kết thúc. Kết quả loạn lên hết.

Cách an toàn hơn:
Dim SavedEventState As Boolean
SavedEventState = Application.EnableEvents
Application.EnableEvents=False '(tắt)
....
Application.EnableEvents=SavedEventState '(trả về trạng thái ban đầu)

 

[ndhmoney686]

Xem qua, thì thấy:
Cũng tạm được thôi, tuy thế code trên liên quán đến gán kết quả xuống ô nhiều (tức là có change trong cells đó --> gọi đến sự kiện Worksheet_Change) nên bạn lưu ý đến việc bật tắt sự kiện sau:

Application.EnableEvents=False '(tắt)
....
Application.EnableEvents=true '(mở)

bạn nên hiểu kỹ bằng cách tìm từ khóa dòng lệnh trên diễn đàn, trước khi cho vào ứng dụng

Việc dùng code để bật tắt này nọ làm kiểu như vậy chỉ an toàn khi có 1 sub. Nếu ó nhiều hơn 1, tức à có khả năng sub này gọi sub kia thì phải cẩn thận. Điều này tôi đã từng khuyến cáo 1 vài lần rồi.
Ví dụ: sub A có 2 lệnh trên. Sub A gọi sub B. Sub B cũng có 2 lệnh trên. Như vậy, Application.EnableEvents được B gán trở lại thành true trước khi A kết thúc. Kết quả loạn lên hết.

Cách an toàn hơn:
Dim SavedEventState As Boolean
SavedEventState = Application.EnableEvents
Application.EnableEvents=False '(tắt)
....
Application.EnableEvents=SavedEventState '(trả về trạng thái ban đầu)

Cám ơn bạn VetMini và Giodong!. Em đã test Application.EnableEvents trong một số ví dụ trên GPE, chắc phải code một thời gian và nhờ các bác chỉ bảo thì mới áp dụng được hiệu quả.

 

[tueyennhi]

Cho em hỏi code sau sẽ quét lọc giá trị duy nhất ở cột 1 với điều kiện <=29999, và sau đó căn cứ giá trị duy nhất này em lấy tiếp giá trị tương ứng ở cột 37, thì em viết như vậy là đúng hay sai ạ.

For Each Ws In Worksheets
    If Ws.Name <> "Form" And Ws.Name <> "Check" And Ws.Name <> "BCC" And Ws.Name <> "25" Then
        C = Col.Item(Val(Ws.Name))
        sArr = Ws.Range("C9", Ws.Range("C9").End(xlDown)).Resize(, 37).Value
        For I = 1 To UBound(sArr)
            Tem = sArr(I, 1)
            If Not Dic.Exists(Tem) Then
                If sArr(I, 1) <= 29999 Then ‘Chi lay gia tri <=29999
                    K = K + 1
                    Dic.Add Tem, K
                    dArr(K, 1) = sArr(I, 1)
                    Rws = Dic.Item(Tem)
                    dArr(Rws, C) = sArr(I, 37)
                End If
            End If
        Next I
    End If
Next Ws