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

ndu96081631 · 24/9/13

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

lhthai · 12/9/14

Chào các anh GPE
Hiện tại em có file chạy macro sau có điều kiện như sau
Tại Sheet Data dùng Advancel Filter để lộc kết quả
Nay muốn kết quả trả sang sheet 3 được không

Mã:

Sub Datasort()
    Range("B1:M6500").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Sheets("SORT").Range("B2:M100"), CopyToRange:=Range("T2:AE2"), Unique:= _
        False
    Range("B1:M6500").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Sheets("SORT").Range("S2:AD100"), CopyToRange:=Range("AJ2:AU2"), Unique:= _
        False
    ActiveWindow.SmallScroll ToRight:=4
    Range("T2:AF2").Select
    Range("AF2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("AF3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    ActiveWindow.LargeScroll ToRight:=0
    ActiveWindow.SmallScroll ToRight:=7
    Range("AJ2:AV2").Select
    Range("AV2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("AV3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("B2").Select
End Sub

ninhmoon · 12/9/14

Tìm lỗi code

[GPECODE=vb]
Sub hide1colum()
Dim n As String, t As String, numcol As Long
n = ActiveSheet.Shapes(Application.Caller).Name
t = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
numcol = Mid(t, 2, Application.WorksheetFunction.Find(")", t) - 2)

If ActiveSheet.Shapes(n).ControlFormat.Value = xlOn Then
Columns(numcol).EntireColumn.Hidden = True

Else
Columns(numcol).EntireColumn.Hidden = False
End If

End Sub

[/GPECODE]
Mọi người cho e hỏi, cái
"n = ActiveSheet.Shapes(Application.Caller).Name" e bị sai cái chi mà ko chạy được

Hoàng Trọng Nghĩa · 12/9/14

Bạn đưa file đó lên đây, đoán non đoán già trong cái shape của bạn ghi chép cái gì thì khó khăn quá!

Hoàng Trọng Nghĩa · 13/9/14

lhthai đã viết:
_Rất hay cám ơn anh nha
Em muốn bổ sung thếm 1 điều kiện như sau
Chẳng hạn trong các file em gửi co trường họp sau tên file NVY300 có 18 dòng còn file NVY914 có 21dong
Em muốn khi copy chỉ lấy giá trị của cột A:F & A:M dán qua thôi không biết code có làm được không anh
Em chỉ hỏi thêm vậy thôi

Tôi chưa hiểu cái dòng tô đỏ. Có phải bạn muốn nói là ở cột A:F - A:M nếu giá trị có bao nhiêu hàng thì lấy bấy nhiêu hàng (dù nhiều hàng hay ít hàng) phải vậy không?

ninhmoon · 13/9/14

Hoàng Trọng Nghĩa đã viết:
Bạn đưa file đó lên đây, đoán non đoán già trong cái shape của bạn ghi chép cái gì thì khó khăn quá!

Em đưa file nên. tại e cũng ko hiểu nó thế nào

Hoàng Trọng Nghĩa · 13/9/14

lhthai đã viết:

Chào các anh GPE
Hiện tại em có file chạy macro sau có điều kiện như sau
Tại Sheet Data dùng Advancel Filter để lộc kết quả
Nay muốn kết quả trả sang sheet 3 được không

Mã:

Sub Datasort()
    Range("B1:M6500").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Sheets("SORT").Range("B2:M100"), CopyToRange:=Range("T2:AE2"), Unique:= _
        False
    Range("B1:M6500").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Sheets("SORT").Range("S2:AD100"), CopyToRange:=Range("AJ2:AU2"), Unique:= _
        False
    ActiveWindow.SmallScroll ToRight:=4
    Range("T2:AF2").Select
    Range("AF2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("AF3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    ActiveWindow.LargeScroll ToRight:=0
    ActiveWindow.SmallScroll ToRight:=7
    Range("AJ2:AV2").Select
    Range("AV2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("AV3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("B2").Select
End Sub

Không biết có đúng không, do bạn dùng AdvancedFilter mà lại chọn hết các cột, có nghĩa là bạn copy toàn bộ dữ liệu qua nên tôi làm cho bạn như thế này mà không cần phải dùng đến AdvancedFilter:

Mã:

Sub Datasort()
    Dim Arr
    Dim r As Long
    With Sheets("DATA")
        r = .Range("B" & Rows.Count).End(xlUp).Row
        Arr = .Range("B2:M" & r)
        r = UBound(Arr)
    End With
    With Sheets("Sheet3")
        .Range("B3:M" & Rows.Count).ClearContents
        .Range("R3:AC" & Rows.Count).ClearContents
        .Range("B3:M3").Resize(r) = Arr
        .Range("R3:AC3").Resize(r) = Arr
        .Range("B3:N3").Resize(r).Sort .Range("N2"), xlAscending
        .Range("R3:AD3").Resize(r).Sort .Range("AD2"), xlAscending
    End With
End Sub

Xem file đính kèm.

Hoàng Trọng Nghĩa · 13/9/14

ninhmoon đã viết:
Em đưa file nên. tại e cũng ko hiểu nó thế nào

Trời ơi, cái file của bạn đâu rồi? Sao không up lên đây đi?

tanlocsonyuser · 13/9/14

Mọi người sao mình dung code này thì bị lỗi Out of range vậy?

Mã:

 Set d = CreateObject("excel.Application")
 Worksheets("BANG2").Cells(1, 2).Value = d.WorksheetFunction.max(IIf(Range("A4:$A100").Value = test, Range("F4:F100"), ""))

Hoàng Trọng Nghĩa · 13/9/14

tanlocsonyuser đã viết:
Mọi người sao mình dung code này thì bị lỗi Out of range vậy?

Mã:

Set d = CreateObject("excel.Application") Worksheets("BANG2").Cells(1, 2).Value = d.WorksheetFunction.max(IIf(Range("A4:$A100").Value = test, Range("F4:F100"), ""))

Gửi cả Sub lên đây đi bạn ơi, không phải nó tô vàng ở chỗ này mà lỗi tại đây đâu, lỗi này có lẽ do khai báo, nếu quá kiểu dữ liệu sẽ cho ra lỗi này.

thanhduc_iit · 15/9/14

Mã:

CThuc "NGOAI", "93001", "C8"
CThuc "NOI", "93001", "C8"
CThuc "TONG", "93001", "C8"
CThuc "NGOAI", "93007", "C15"
CThuc "NOI", "93007", "C15"
CThuc "TONG", "93007", "C15"
CThuc "NGOAI", "93002", "C22"
CThuc "NOI", "93002", "C22"
CThuc "TONG", "93002", "C22"
CThuc "NGOAI", "93003", "C29"
CThuc "NOI", "93003", "C29"
CThuc "TONG", "93003", "C29"
CThuc "NGOAI", "93004", "C36"
CThuc "NOI", "93004", "C36"
CThuc "TONG", "93004", "C36"
CThuc "NGOAI", "93016", "C43"
CThuc "NOI", "93016", "C43"
CThuc "TONG", "93016", "C43"
CThuc "NGOAI", "93006", "C50"
CThuc "NOI", "93006", "C50"
CThuc "TONG", "93006", "C50"
CThuc "NGOAI", "93005", "C57"
CThuc "NOI", "93005", "C57"
CThuc "TONG", "93005", "C57"
CThuc "NGOAI", "93101", "C64"
CThuc "NOI", "93101", "C64"
CThuc "TONG", "93101", "C64"
CThuc "NGOAI", "93102", "C71"
CThuc "NOI", "93102", "C71"
CThuc "TONG", "93102", "C71"

Sub CThuc(a As String, b As String, c As String)
    ...
End Sub

Em làm mãi mà vẫn chưa tìm ra cách rút gọn đoạn code trên &&&%$R

Các bác giúp em với ạ

hungpecc1 · 15/9/14

thanhduc_iit đã viết:

Mã:

CThuc "NGOAI", "93001", "C8"
CThuc "NOI", "93001", "C8"
CThuc "TONG", "93001", "C8"
CThuc "NGOAI", "93007", "C15"
CThuc "NOI", "93007", "C15"
CThuc "TONG", "93007", "C15"
CThuc "NGOAI", "93002", "C22"
CThuc "NOI", "93002", "C22"
CThuc "TONG", "93002", "C22"
CThuc "NGOAI", "93003", "C29"
CThuc "NOI", "93003", "C29"
CThuc "TONG", "93003", "C29"
CThuc "NGOAI", "93004", "C36"
CThuc "NOI", "93004", "C36"
CThuc "TONG", "93004", "C36"
CThuc "NGOAI", "93016", "C43"
CThuc "NOI", "93016", "C43"
CThuc "TONG", "93016", "C43"
CThuc "NGOAI", "93006", "C50"
CThuc "NOI", "93006", "C50"
CThuc "TONG", "93006", "C50"
CThuc "NGOAI", "93005", "C57"
CThuc "NOI", "93005", "C57"
CThuc "TONG", "93005", "C57"
CThuc "NGOAI", "93101", "C64"
CThuc "NOI", "93101", "C64"
CThuc "TONG", "93101", "C64"
CThuc "NGOAI", "93102", "C71"
CThuc "NOI", "93102", "C71"
CThuc "TONG", "93102", "C71"

Sub CThuc(a As String, b As String, c As String)
    ...
End Sub

Em làm mãi mà vẫn chưa tìm ra cách rút gọn đoạn code trên &&&%$R

Các bác giúp em với ạ

Rút gọn kiểu này được không /

Mã:

Sub GPE()
    Dim Arr1, Arr2
    Dim i&
        Arr1 = Array("93001,93002,93007,....)
        Arr2 = Array("C8","C12","C15",....)
        For i = 0 To UBound(Arr1)
            CThuc "NOI", Arr1(i), Arr2(i)
            CThuc "NGOAI", Arr1(i), Arr2(i)
            CThuc "TONG", Arr1(i), Arr2(i)
        Next
End Sub

thanhduc_iit · 15/9/14

hungpecc1 đã viết:

Rút gọn kiểu này được không /

Mã:

Sub GPE()
    Dim Arr1, Arr2
    Dim[COLOR=#ff0000] i&[/COLOR]
        Arr1 = Array("93001,93002,93007,....)
        Arr2 = Array("C8","C12","C15",....)
        For i = 0 To UBound(Arr1)
            CThuc "NOI", Arr1(i), Arr2(i)
            CThuc "NGOAI", Arr1(i), Arr2(i)
            CThuc "TONG", Arr1(i), Arr2(i)
        Next
End Sub

Em cũng từng thử cách này, vấn đề nằm ngay chổ i& :-=

Nhưng vẫn bị cái ByRef argument type mismatch
Thanks bác

hungpecc1 · 15/9/14

thanhduc_iit đã viết:
Em cũng từng thử cách này, vấn đề nằm ngay chổ i&
Nhưng vẫn bị cái ByRef argument type mismatch
Thanks bác

test thử code sau ,mình nghĩ vẫn đền không phải nằm ở chỗ biến i

Mã:

Sub GPE()
    Dim Arr1, Arr2
    Dim i&
        Arr1 = Array("93001", "93002", "93007")
        For i = 0 To UBound(Arr1)
            Debug.Print Arr1(i)
        Next
End Sub

muốn biến cụ thể thế nào chỉ cách upfile cụ thể lên mới biết được

phihndhsp · 15/9/14

Xin hỏi Dim i&?? là gì? có phải là khai báo kiểu con trỏ không? xin được giải thích để học hỏi. Xin cảm ơn nhiều

quocphuoc88 · 15/9/14

phihndhsp đã viết:
Xin hỏi Dim i&?? là gì? có phải là khai báo kiểu con trỏ không? xin được giải thích để học hỏi. Xin cảm ơn nhiều

theo mình biết là khai báo biến i , ở đây tác giả ghi tắt bằng ký hiệu, các ký hiệu là :
String $
Integer %
Long &
Single !
Double #
Currency @

Hau151978 · 16/9/14

thanhduc_iit đã viết:
Em cũng từng thử cách này, vấn đề nằm ngay chổ i&
Nhưng vẫn bị cái ByRef argument type mismatch
Thanks bác

Mình nghĩ có thể do sai kiểu tham số. Bạn thử sửa thành
Sub CThuc(a,b,c)
End sub
xem được không, mình không có máy để test.

VetMini · 16/9/14

Hau151978 đã viết:
Mình nghĩ có thể do sai kiểu tham số. Bạn thử sửa thành
Sub CThuc(a,b,c)
End sub
xem được không, mình không có máy để test.

Bạn nghĩ đúng rồi. Đây là lỗi compiler chứ không phải lỗi run time. Vì Arr1 chỉ khai báo suông không có kiểu cho nên mặc định là variant. Khi compiler kết nối với sub CThuc thì không ép kiểu được sang string.
Lưu ý là compiler kết nối trước khi code chạy - sau khi code chạy thì nó biết Arr1(i) là sttring.
Nếu bạn đổi khai báo Dim Arr1() as string thì sẽ không còn lỗi compiler nữa. Nhưng lúc chạy, bạn sẽ bị lỗi "type mismatch" ở dỏng Arr1 = Array(...). Đó là lỗi run time.
Nếu hàm CThuc không thay đổi trị của tham số thì (khai báo ByVal) có thể dùng CThuc "TONG", Cstr(Arr1(i)), Cstr(Arr2(i)).
Lưu ý là code của người hỏi căn bản đã phạm lỗi gọi hàm khi khai báo tham biến (ByRef) nhưng nạp tham số là hằng ("TONG").

Đây là tôi trả lời cho riêng vấn đề ngữ thuật. Tôi vốn không muốn trả lời thẳng cho người hỏi vì 2 lý do: 1. tôi kỵ những người hỏi dùng tiếng Anh; 2. chen ngang câu hỏi không thuộc về thuật toán vào thớt này là bất lịch sự.

=== bổ sung ===
Câu hỏi này vốn được người hỏi chen ngang vào thớt "Trao đổi về thuật toán trong lập trình VBA". Vì vấn đề không phải thuật toán cho nên tôi khẳng định hành động là bất lịch sự.
Sáng nay BQT đã dời nó vào đây, đúng chỗ của nó hơn.

Excel365 · 16/9/14

Rút gon code

[GPECODE=vb]Option ExplicitSub CopyCongSP()
Dim lRs As Long
lRs = LDQuanLy.[A65500].End(xlUp).Row - 10
ActiveSheet.Cells(11, 1).FormulaR1C1 = "=IF(RC9<>"""",RC[93],"""")"
ActiveSheet.Cells(11, 1).AutoFill Cells(11, 1).Resize(lRs)
ActiveSheet.Cells(11, 2).FormulaR1C1 = "=IF(RC9<>"""",RC[32],"""")"
ActiveSheet.Cells(11, 2).AutoFill Cells(11, 2).Resize(lRs)
ActiveSheet.Cells(11, 3).FormulaR1C1 = "=IF(AND(RC9<>"""",RC[63]<>""""),RC[63],"""")"
ActiveSheet.Cells(11, 3).AutoFill Cells(11, 3).Resize(lRs)
End Sub[/GPECODE]

Với đoạn code như trên thì cho em hỏi có cách nào để viết cho nó ngắn gon hơn nữa không?
Nhờ các anh chị giúp đỡ.
Trân trọng

nmhung49 · 16/9/14

huuduy.duy đã viết:
[GPECODE=vb]Option ExplicitSub CopyCongSP()
Dim lRs As Long
lRs = LDQuanLy.[A65500].End(xlUp).Row - 10
ActiveSheet.Cells(11, 1).FormulaR1C1 = "=IF(RC9<>"""",RC[93],"""")"
ActiveSheet.Cells(11, 1).AutoFill Cells(11, 1).Resize(lRs)
ActiveSheet.Cells(11, 2).FormulaR1C1 = "=IF(RC9<>"""",RC[32],"""")"
ActiveSheet.Cells(11, 2).AutoFill Cells(11, 2).Resize(lRs)
ActiveSheet.Cells(11, 3).FormulaR1C1 = "=IF(AND(RC9<>"""",RC[63]<>""""),RC[63],"""")"
ActiveSheet.Cells(11, 3).AutoFill Cells(11, 3).Resize(lRs)
End Sub[/GPECODE]

Với đoạn code như trên thì cho em hỏi có cách nào để viết cho nó ngắn gon hơn nữa không?
Nhờ các anh chị giúp đỡ.
Trân trọng

Rút gọn thì vậy với With ...End with

[GPECODE=vb]
Sub Rutgon()
With ActiveSheet
With .Cells(11, 1)
.FormulaR1C1 = "=IF(RC9<>"""",RC[93],"""")"
.AutoFill Cells(11, 1).Resize(lRs)
End With
With .Cells(11, 2)
.FormulaR1C1 = "=IF(RC9<>"""",RC[32],"""")"
.AutoFill Cells(11, 2).Resize(lRs)
End With
With .Cells(11, 3)
.FormulaR1C1 = "=IF(AND(RC9<>"""",RC[63]<>""""),RC[63],"""")"
.AutoFill Cells(11, 3).Resize(lRs)
End With
End Sub

[/GPECODE]

Excel365 · 16/9/14

nmhung49 đã viết:
Rút gọn thì vậy với With ...End with

[GPECODE=vb]
Sub Rutgon()
With ActiveSheet
With .Cells(11, 1)
.FormulaR1C1 = "=IF(RC9<>"""",RC[93],"""")"
.AutoFill Cells(11, 1).Resize(lRs)
End With
With .Cells(11, 2)
.FormulaR1C1 = "=IF(RC9<>"""",RC[32],"""")"
.AutoFill Cells(11, 2).Resize(lRs)
End With
With .Cells(11, 3)
.FormulaR1C1 = "=IF(AND(RC9<>"""",RC[63]<>""""),RC[63],"""")"
.AutoFill Cells(11, 3).Resize(lRs)
End With
End Sub

[/GPECODE]

Code báo lỗi ạ, nhờ nmhung49 xem lại giúp em

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

Người dùng đang xem chủ đề này

Huyền thoại GPE

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

Thành viên tiêu biểu

Chuyên gia GPE

Chuyên gia GPE

Thành viên tiêu biểu

Chuyên gia GPE

File đính kèm

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

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

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

Thành viên tích cực

Ăn cùng góc phố

Thành viên tích cực

Thành viên tích cực

Thành viên tích cực

Đếm ngược thời gian