Chuyên mục xử lý, gỡ rối code VBA (1 người xem)

[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

 

[nilt02]

Tại e tưởng sau khi clear listbox rồi thì muốn gán mấy chiều vào cũng được, listbox sẽ nhận số chiều theo lệnh .list(...)
như vậy là listbox sẽ nhận số chiều của mảng gán lúc đầu, không thay đổi được à các bác?

Thay đổi được, nếu bạn gán lại list() với mảng mới

 

[huuthang_bd]

Tại e tưởng sau khi clear listbox rồi thì muốn gán mấy chiều vào cũng được, listbox sẽ nhận số chiều theo lệnh .list(...)
như vậy là listbox sẽ nhận kích thước của mảng gán lúc đầu, không thay đổi được à các bác?

Nếu bạn gán một mảng cho thuộc tính .List thì số cột là kích thước chiều thứ hai của mảng được gán. Nếu bạn dùng phương thức .Additem ngay từ đầu thì số cột là giá trị thuộc tính .ColumnCount.

 

[hongphuong1997]

Định đố hay sao ấy chứ

Sheets(Array("1", "2", "3", "4")).FillAcrossSheets Sheets("1").Range("B2")

(Nếu tôi nhớ không lầm thì tôi đã từng đố câu gần tương tự trong mục đối vui về VBA)

Hay quá bác ndu96081631 ơi, không cần phải vòng lặp nào cả, Bác làm như nào vậy hả bác?

 

[hongphuong1997]

Cho xin 500 bức hình để được thỏa con mắt về cái lỗi lầm kia.

Anh ơi, người ta chưa biết và mới học thì mới mắc sai lầm, anh là người am hiểu nếu anh biết thì anh chỉ dẫn giúp cho người ta đi. Sao anh lại nói như vậy? @truongvu317

 

[truongvu317]

Anh ơi, người ta chưa biết và mới học thì mới mắc sai lầm, anh là người am hiểu nếu anh biết thì anh chỉ dẫn giúp cho người ta đi. Sao anh lại nói như vậy? @truongvu317

Tui chả phải là người am hiểu gì cả, nhưng tui nói thật. Cái thứ nhất phải có file, phải có dữ liệu, mô tả mã lỗi.... Không có thì chả khác nào đánh đố nhau.

 

[be_09]

Em chào các anh.
Em sưu tầm được cái này để làm nút tắt di chuyển qua lại 2 sheet.
Nhưng khi em dán vào Personal VBA thì nó báo lỗi dòng
Application.OnKey “%`”, “ToggleBack”
Các anh có thể giúp em không ạ. Em cám ơn

Dim TabTracker As New TabBack_Class
Sub TabBack_Run()
'PURPOSE: Initiate Tab tracking and shortcut key trigger
‘SOURCE: www.TheSpreadsheetGuru.com
'Enable TabTracker class
Set TabTracker.AppEvent = Application
'Call ToggleBack macro when user keys alt + `
Application.OnKey “%`”, “ToggleBack”
End Sub
Sub ToggleBack()
'PURPOSE: Go Back to Previous Worksheet
‘SOURCE: www.TheSpreadsheetGuru.com
With TabTracker
On Error Resume Next
Workbooks(.WorkbookReference).Worksheets(.SheetReference).Activate
On Error GoTo 0
End With
End Sub

Bạn này sao cứ kiên trì cái phím tắt, tôi thì không thích ba cái vụ này. Thay dòng code này vào thử coi có gì khác không?

Application.OnKey "%`", "ToggleBack"

 

[aries8214]

Nếu bạn gán một mảng cho thuộc tính .List thì số cột là kích thước chiều thứ hai của mảng được gán. Nếu bạn dùng phương thức .Additem ngay từ đầu thì số cột là giá trị thuộc tính .ColumnCount.

Bác cho hỏi thêm một chút là em muốn hiện số dòng của listbox listcount vào một label mỗi khi số dòng của listbox thay đổi, em đã thử dùng sự kiện listbox change, listbox after update nhưng không hiệu quả.

 

[huuthang_bd]

Bác cho hỏi thêm một chút là em muốn hiện số dòng của listbox listcount vào một label mỗi khi số dòng của listbox thay đổi, em đã thử dùng sự kiện listbox change, listbox after update nhưng không hiệu quả.

Không có sự kiện có sẵn kiểu như vậy đâu. Số dòng của listbox thay đổi là do bạn thực hiện một lệnh nào đó, như vậy bạn muốn đếm thì đếm khi thực hiện lệnh đó là được.

 

[aries8214]

Không có sự kiện có sẵn kiểu như vậy đâu. Số dòng của listbox thay đổi là do bạn thực hiện một lệnh nào đó, như vậy bạn muốn đếm thì đếm khi thực hiện lệnh đó là được.

Thanks bác nhiều, nhờ bác chỉ dẫn e đã gần hoàn thành được chương trình rồi. Tuy nhiên e đang còn một chỗ mắc cuối nhờ bác xem giúp.
E muốn viết code để tra ngược, khi search vật tư: click vào listbox vật tư -> hiện thiết bị ở listbox thiết bị và khi search thiết bị: click vào listbox thiết bị -> vật tư ở listbox vật tư, việc search vật tư hay search thiết bị chọn bằng option button. Vế 1 em đã làm ok, nhưng ở vế 2: thiết bị -> vật tư thì chỉ chạy khi textbox trống, còn textbox có kí tự thì không chạy. E nghĩ đây không phải lỗi code mà lỗi logic, tuy nhiên e chưa tìm ra được, nhờ bác xem giúp.

 

[huongmuine]

Nhờ các anh chị chỉ giúp sửa code để ký hiệu ngày nghỉ theo mã nv điền đúng ngày trong sheet "8".
Xin cảm ơn.

 

[♫ђöล♥ßล†♥†µ♫]

Nhờ các anh chị chỉ giúp sửa code để ký hiệu ngày nghỉ theo mã nv điền đúng ngày trong sheet "8".
Xin cảm ơn.

Không biết có phải như vầy không

Sub CongCham()
    Dim Rng, sArr, tArr, dArr, I As Long, J As Long, Col As Long, R As Long
    Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet9
    Set Rng = .Range("E8:AI8")
    sArr = .Range("B10", .Range("B" & Rows.Count).End(xlUp)).Resize(, 34).Value
End With
With Sheet3
    tArr = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr)
    Dic.Item(CStr(tArr(I, 3))) = I
Next I
ReDim dArr(1 To UBound(sArr), 1 To 31)
For I = 1 To UBound(sArr)
    R = Dic.Item(sArr(I, 1))
    If R Then
        For J = 1 To Rng.Columns.Count
            If tArr(R, 1) = Rng(1, J) Then
                Col = J: Exit For
            End If
        Next J
        If Col Then dArr(I, Col) = tArr(R, 6)
        Col = 0
    End If  
Next I
Sheet9.Range("E10:AI10").Resize(I - 1).ClearContents
Sheet9.Range("E10:AI10").Resize(I - 1) = dArr
End Sub

 

[huongmuine]

Không biết có phải như vầy không

Sub CongCham()
    Dim Rng, sArr, tArr, dArr, I As Long, J As Long, Col As Long, R As Long
    Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet9
    Set Rng = .Range("E8:AI8")
    sArr = .Range("B10", .Range("B" & Rows.Count).End(xlUp)).Resize(, 34).Value
End With
With Sheet3
    tArr = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr)
    Dic.Item(CStr(tArr(I, 3))) = I
Next I
ReDim dArr(1 To UBound(sArr), 1 To 31)
For I = 1 To UBound(sArr)
    R = Dic.Item(sArr(I, 1))
    If R Then
        For J = 1 To Rng.Columns.Count
            If tArr(R, 1) = Rng(1, J) Then
                Col = J: Exit For
            End If
        Next J
        If Col Then dArr(I, Col) = tArr(R, 6)
        Col = 0
    End If
Next I
Sheet9.Range("E10:AI10").Resize(I - 1).ClearContents
Sheet9.Range("E10:AI10").Resize(I - 1) = dArr
End Sub

Cảm ơn bạn đã giúp đỡ.
Nhờ Bạn chỉnh lại giúp mình tí nữa ạ. Vì từ cột E:AI có đánh dấu "+" cho ngày làm việc hoặc "TB", "CN". Khi mình sử dụng code này thì nó xóa hết các ngày chấm công.

 

[♫ђöล♥ßล†♥†µ♫]

Cảm ơn bạn đã giúp đỡ.
Nhờ Bạn chỉnh lại giúp mình tí nữa ạ. Vì từ cột E:AI có đánh dấu "+" cho ngày làm việc hoặc "TB", "CN". Khi mình sử dụng code này thì nó xóa hết các ngày chấm công.

Bạn thử lại Code này

Public Sub CongCham()
    Dim Rng, sArr, tArr, dArr, I As Long, J As Long, R As Long
    Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet9
    Set Rng = .Range("E8:AI8")
    sArr = .Range("B10", .Range("B" & Rows.Count).End(xlUp)).Resize(, 34).Value
End With
With Sheet3
    tArr = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr)
    Dic.Item(CStr(tArr(I, 3))) = I
Next I
ReDim dArr(1 To UBound(sArr), 1 To 31)
For I = 1 To UBound(sArr)
    R = Dic.Item(sArr(I, 1))
    For J = 1 To Rng.Columns.Count
        If R Then
            If tArr(R, 1) = Rng(1, J) Then
                dArr(I, J) = tArr(R, 6)
            Else
                dArr(I, J) = sArr(I, J + 3)
            End If
        Else
            dArr(I, J) = sArr(I, J + 3)
        End If
    Next J
Next I
Sheet9.Range("E10:AI10").Resize(I - 1).ClearContents
Sheet9.Range("E10:AI10").Resize(I - 1) = dArr
Set Dic = Nothing
End Sub

 

[huongmuine]

Bạn thử lại Code này

Public Sub CongCham()
    Dim Rng, sArr, tArr, dArr, I As Long, J As Long, Col As Long, R As Long
    Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet9
    Set Rng = .Range("E8:AI8")
    sArr = .Range("B10", .Range("B" & Rows.Count).End(xlUp)).Resize(, 34).Value
End With
With Sheet3
    tArr = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr)
    Dic.Item(CStr(tArr(I, 3))) = I
Next I
ReDim dArr(1 To UBound(sArr), 1 To 31)
For I = 1 To UBound(sArr)
    R = Dic.Item(sArr(I, 1))
    For J = 1 To Rng.Columns.Count
        If R Then
            If tArr(R, 1) = Rng(1, J) Then
                Col = J: dArr(I, Col) = tArr(R, 6): Col = 0
            Else
                dArr(I, J) = sArr(I, J + 3)
            End If
        Else
            dArr(I, J) = sArr(I, J + 3)
        End If
    Next J
Next I
Sheet9.Range("E10:AI10").Resize(I - 1).ClearContents
Sheet9.Range("E10:AI10").Resize(I - 1) = dArr
Set Dic = Nothing
End Sub

Cảm ơn bạn thật nhiều.
Chúc bạn buổi tối nhiều niềm vui.

 

[huongmuine]

Bạn thử lại Code này

Public Sub CongCham()
    Dim Rng, sArr, tArr, dArr, I As Long, J As Long, R As Long
    Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet9
    Set Rng = .Range("E8:AI8")
    sArr = .Range("B10", .Range("B" & Rows.Count).End(xlUp)).Resize(, 34).Value
End With
With Sheet3
    tArr = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr)
    Dic.Item(CStr(tArr(I, 3))) = I
Next I
ReDim dArr(1 To UBound(sArr), 1 To 31)
For I = 1 To UBound(sArr)
    R = Dic.Item(sArr(I, 1))
    For J = 1 To Rng.Columns.Count
        If R Then
            If tArr(R, 1) = Rng(1, J) Then
                dArr(I, J) = tArr(R, 6)
            Else
                dArr(I, J) = sArr(I, J + 3)
            End If
        Else
            dArr(I, J) = sArr(I, J + 3)
        End If
    Next J
Next I
Sheet9.Range("E10:AI10").Resize(I - 1).ClearContents
Sheet9.Range("E10:AI10").Resize(I - 1) = dArr
Set Dic = Nothing
End Sub

Bạn giúp mình tí nữa ạ. Mình thử 2 ngày nghỉ cho 1 mã nv nhưng code chỉ lấy ngày sau cùng.

 

[♫ђöล♥ßล†♥†µ♫]

Bạn giúp mình tí nữa ạ. Mình thử 2 ngày nghỉ cho 1 mã nv nhưng code chỉ lấy ngày sau cùng.

Bạn thử xem

Public Sub CongCham()
    Dim Rng, sArr, tArr, dArr, I As Long, J As Long
    Dim Dic As Object, sKey As String, R As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet9
    Set Rng = .Range("E8:AI8")
    sArr = .Range("B10", .Range("B" & Rows.Count).End(xlUp)).Resize(, 34).Value
End With
With Sheet3
    tArr = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr)
    sKey = tArr(I, 1) & "#" & tArr(I, 3)
    Dic.Item(sKey) = I
Next I
ReDim dArr(1 To UBound(sArr), 1 To 31)
For I = 1 To UBound(sArr)
    For J = 1 To Rng.Columns.Count
        sKey = Rng(1, J) & "#" & sArr(I, 1)
        R = Dic.Item(sKey)
        If R Then
            dArr(I, J) = tArr(R, 6)
        Else
            dArr(I, J) = sArr(I, J + 3)
        End If
    Next J
Next I
With Sheet9
    .Range("E10:AI10").Resize(I - 1).ClearContents
    .Range("E10:AI10").Resize(I - 1) = dArr
End With

còn sai đâu không nha

 

[huongmuine]

Bạn thử xem

Public Sub CongCham()
    Dim Rng, sArr, tArr, dArr, I As Long, J As Long
    Dim Dic As Object, sKey As String, R As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet9
    Set Rng = .Range("E8:AI8")
    sArr = .Range("B10", .Range("B" & Rows.Count).End(xlUp)).Resize(, 34).Value
End With
With Sheet3
    tArr = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr)
    sKey = tArr(I, 1) & "#" & tArr(I, 3)
    Dic.Item(sKey) = I
Next I
ReDim dArr(1 To UBound(sArr), 1 To 31)
For I = 1 To UBound(sArr)
    For J = 1 To Rng.Columns.Count
        sKey = Rng(1, J) & "#" & sArr(I, 1)
        R = Dic.Item(sKey)
        If R Then
            dArr(I, J) = tArr(R, 6)
        Else
            dArr(I, J) = sArr(I, J + 3)
        End If
    Next J
Next I
With Sheet9
    .Range("E10:AI10").Resize(I - 1).ClearContents
    .Range("E10:AI10").Resize(I - 1) = dArr
End With

còn sai đâu không nha

Cảm ơn bạn đã nhiệt tình giúp đỡ.

 

[vutienml]

Xin gỡ rối dùm tôi file excel này, xin cảm ơn nhiều.
Khi tôi chạy Hoàn Thành ở sheets HCC thì báo lỗi ActiveSheet.Paste, sau đó lại chuyển qua lỗi khác.
Mong mọi người giúp, xin cảm ơn.

 

[be_09]

Xin gỡ rối dùm tôi file excel này, xin cảm ơn nhiều.
Khi tôi chạy Hoàn Thành ở sheets HCC thì báo lỗi ActiveSheet.Paste, sau đó lại chuyển qua lỗi khác.
Mong mọi người giúp, xin cảm ơn.View attachment 196735

1/ Ở Topic kia tôi cũng đã góp ý cho bạn là nên nêu rỏ vấn đề cần làm rồi nhờ giúp, người giúp đập bỏ đi và có giải pháp khác rồi làm lại chỉ vài dòng code còn nhanh hơn là mò sửa cái cái Record Macro (sẽ không hiểu hết ý của bạn), nhưng bạn lại không nghe và đưa lên một đống code thừa thải.
2/ Chỉ cần lọc, Add sheet rồi đặt tên sheet mới với tên Cell nào đó chắc khoảng hơn chục dòng code, còn muốn tra bất kỳ cột nào cũng chỉ khoảng chục dòng code nữa thôi. Trong khi bạn Record Macro hơn 100 dòng nhưng chưa chắc đã đáp ứng hết những cái tôi vừa nêu.

Bài kia do bạn vi phạm nội quy nên bị khóa bài viết. Xem ở Link sau:
https://www.giaiphapexcel.com/diendan/threads/chào-mọi-người-mọi-người-có-thể-xem-giúp-tôi-lỗi-của-file-này-được-chứ-xin-cảm-ơn.135154/

 

[be_09]

............................
[/ATTACH]

Bạn nên tập thói quen nhận ý kiến đóng góp của các thành viên mới mong nhận được giải pháp tốt nhất.
1/ Cái đầu tiên người trợ giúp phải hiểu bạn muốn làm cái gì? Người ta có hiểu mới giúp được.
2/ Không thành viên nào hiểu cái ý tưởng của bạn nếu bạn không nêu rỏ muốn và cần làm cái gì? Khi hiểu mới cho bạn 1 giải pháp tốt nhất.
3/ Nhìn cái tiêu đề đến 85 cột mà lặp đi lặp lại thì người ta nhìn thấy cũng đã chóng mặt rồi, nên chẳng ai dám vào góp ý hay đưa ra giải pháp khác thì bạn cũng phần nào hiểu được vấn đề.