Lỗi code không nhận giá trị (1 người xem)

[thoai]

Nhờ AC chỉnh sửa dùm code sao cho 4 ô list box sẽ lấy dữ liệu từ 4 sheet tương ứng:
+ LB1: lấy dữ liệu ở sheet SKOD.
+ LB2: lấy dữ liệu ở sheet SKOT.
+ LB3: lấy dữ liệu ở sheet TMOD.
+ LB4: lấy dữ liệu ở sheet TMOT.

 

[gttrongvn]

Mình xóa đi ít chỗ và chỉnh sửa ít chỗ, kết quả vẫn ra được như yêu cầu của bạn, bạn tham khảo thử xem được không.

 

[SA_DQ]

Bạn sửa các thông số trong macro thành như sau:

Sub DuLieuChoListBox(Sh As Worksheet, HThi As String)
Dim Arr()
Dim J As Long, Rws As Long, W As Integer, Dem As Integer, Ghi As Boolean
ReDim dArr(1 To 1141, 1 To 10)   '<=|   !!  '
End Sub

 

[SA_DQ]

Mình xóa đi ít chỗ và chỉnh sửa ít chỗ, kết quả vẫn ra được như yêu cầu của bạn, bạn tham khảo thử xem được không.

& có thể chỉnh lại các macro sự kiện trong trang đó như sau:

Dim Rg0 As Range
Private Sub Worksheet_Activate()
[ac2].CurrentRegion.Offset(1).ClearContents
DVC1.Show
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [c3]) Is Nothing Then
    GPE_SuKien Sheets("SKOD"), Target
        Rg0.Resize(, 9).Copy Destination:=[ac2]
 End If
  If Not Intersect(Target, [c10]) Is Nothing Then
    GPE_SuKien Sheets("SKOT"), [c10]
        Rg0.Resize(, 9).Copy Destination:=[al2]
 End If
  If Not Intersect(Target, [c15]) Is Nothing Then
    GPE_SuKien Sheets("TMOD"), [c15]
        Rg0.Resize(, 9).Copy Destination:=[au2]
 End If
  If Not Intersect(Target, [c19]) Is Nothing Then
    GPE_SuKien Sheets("TMOT"), Target
        Rg0.Resize(, 9).Copy Destination:=[bd2]
 End If
 Set Rg0 = Nothing
End Sub

Sub GPE_SuKien(Sh As Worksheet, Targ As Range)
 Dim Rng As Range, sRng As Range
 
 Set Rng = Sh.Range(Sh.[b4], Sh.[b65500].End(xlUp))
 Set sRng = Rng.Find(Targ.Value, , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
        Set Rg0 = Sh.Range(sRng.Offset(1), sRng.Offset(1, -1).End(xlDown).Offset(, 1))
 End If
End Sub

 

[gttrongvn]

Sub GPE_SuKien(Sh As Worksheet, Targ As Range)
Dim Rng As Range, sRng As Range

Set Rng = Sh.Range(Sh.[b4], Sh.[b65500].End(xlUp))
Set sRng = Rng.Find(Targ.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
        Set Rg0 = Sh.Range(sRng.Offset(1), sRng.Offset(1, -1).End(xlDown).Offset(, 1))
End If
End Sub

Hay quá a, giờ em mới biết là có thể cho các sub kiểu này vào sự kiện trong sheet, trước giờ em chỉ làm trong module để gọi cho lẹ thôi. Nếu được, a chỉ em vấn đề này với, em có sub như vầy để sắp xếp cột khi cần

Sub sap_xep_cot(lastrow As String, table As String, cot1 As String, cot2 As String)
With ActiveSheet
lr = Range(lastrow & Rows.Count).End(xlUp).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range(cot1 & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range(cot2 & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange Range(table & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
.Sort.SortFields.Clear
End With
End Sub

Mỗi lần em muốn sắp xếp cột thì gọi thủ tục này ra

Call sap_xep_cot("A", "A1:H", "A2:A", "C2:C")

Nhưng khi chỉ có một cột cần sắp xếp, em phải làm như thế này

Call sap_xep_cot("A", "A1:H", "A2:A", "A2:A")

Anh chỉnh sửa code giúp em để cot2 thành tùy chọn có thể có hoặc có thể không với, em cảm ơn anh.