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

ThaiDieuAnh · 22/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Hay là như vầy nhỉ

Cảm ơn bác ạ, đúng ý em rồi

HieuCD · 22/4/18

ThaiDieuAnh đã viết:
Các anh chị giúp em sửa lỗi code này với ạ

Mã:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Range("B5:B" & [C65500].End(xlUp).Row), Target) Is Nothing And Target.Count = 1 Then UserForm1.Show Cancel = True End If End Sub

Ví dụ khi em chọn toàn bộ bảng tính hoặc từ hàng nào đó đến hàng cuối cùng hoặc cột nào đó đến cột cuối cùng rồi kích chuột phải thì bị lỗi ạ, em xin cảm ơn

If Not Intersect(Range("B5:B" & [C65500].End(xlUp).Row), Target) Is Nothing And Target.Rows.Count = 1 Then

huongmuine · 24/4/18

Nhờ các anh chị xem giúp:
Trong file khi mình nhập dữ liệu vào cột E thì code chạy
Nhưng khi copy và dán vào thì code không chạy.
Vậy mình phải sửa code như thế nào để code thực hiện lệnh khi copy và dán dữ liệu.
Xin cảm ơn.

huongmuine · 24/4/18

hpkhuong đã viết:
Thêm 1 vòng lặp For each sau dòng If Target.Rows.Count = 1 Then nữa là được

Nghĩa là:

Mã:

Dim Clls as Range If Target.Rows.Count = 1 Then For Each Clls In Target ....... Next End if

[QUOTE="
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Clls As Range
If Target.Column = 5 Then
If Target.Rows.Count = 1 Then
For Each Clls In Target
If Target <> Empty Then
Target.Offset(, 1).Value = "=IF(LEN(DAY(RC[-1]))=1,""0""&TEXT(DAY(RC[-1]),0),TEXT(DAY(RC[-1]),0))"
Target.Offset(, 2).Value = "=IF(LEN(MONTH(RC[-2]))=1,""0""&TEXT(MONTH(RC[-2]),0),TEXT(MONTH(RC[-2]),0))"
Target.Offset(, 3).Value = "=RIGHT(TEXT(YEAR(RC[-3]),0),2)"
Target.Offset(, 4).Value = "=RC[-3]&RC[-2]&RC[-1]"
Else
Target.Offset(, 1) = Empty
Target.Offset(, 2) = Empty
Target.Offset(, 3) = Empty
Target.Offset(, 4) = Empty
Next
End If
End If
End If
End Sub
[/code][/QUOTE]

Mình thêm như vầy nhưng vẫn không được bạn chỉ them cho mình với.
Xin cảm ơn bạn.

phulien1902 · 24/4/18

huongmuine đã viết:
[QUOTE="
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Clls As Range
If Target.Column = 5 Then
If Target.Rows.Count = 1 Then
For Each Clls In Target
If Target <> Empty Then
Target.Offset(, 1).Value = "=IF(LEN(DAY(RC[-1]))=1,""0""&TEXT(DAY(RC[-1]),0),TEXT(DAY(RC[-1]),0))"
Target.Offset(, 2).Value = "=IF(LEN(MONTH(RC[-2]))=1,""0""&TEXT(MONTH(RC[-2]),0),TEXT(MONTH(RC[-2]),0))"
Target.Offset(, 3).Value = "=RIGHT(TEXT(YEAR(RC[-3]),0),2)"
Target.Offset(, 4).Value = "=RC[-3]&RC[-2]&RC[-1]"
Else
Target.Offset(, 1) = Empty
Target.Offset(, 2) = Empty
Target.Offset(, 3) = Empty
Target.Offset(, 4) = Empty
Next
End If
End If
End If
End Sub
[/code]

Mình thêm như vầy nhưng vẫn không được bạn chỉ them cho mình với.
Xin cảm ơn bạn.[/QUOTE]
Có thể làm cách khác:
+ Code Sheet:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$2" Then
        abc
    End If
End Sub
+ Code Module:
[php]
Sub abc()
    With Range("F2:F" & Cells(Rows.Count, 5).End(xlUp).Row)
        .Formula = "=IF(LEN(DAY(RC[-1]))=1,""0""&TEXT(DAY(RC[-1]),0),TEXT(DAY(RC[-1]),0))"
        .Offset(, 1) = "=IF(LEN(MONTH(RC[-2]))=1,""0""&TEXT(MONTH(RC[-2]),0),TEXT(MONTH(RC[-2]),0))"
        .Offset(, 2) = "=RIGHT(TEXT(YEAR(RC[-3]),0),2)"
        .Offset(, 3) = "=RC[-3]&RC[-2]&RC[-1]"
    End With
End Sub

[/php]

huongmuine · 24/4/18

phulien1902 đã viết:
Mình thêm như vầy nhưng vẫn không được bạn chỉ them cho mình với.
Xin cảm ơn bạn.

Có thể làm cách khác:
+ Code Sheet:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$2" Then
        abc
    End If
End Sub
+ Code Module:
[php]
Sub abc()
    With Range("F2:F" & Cells(Rows.Count, 5).End(xlUp).Row)
        .Formula = "=IF(LEN(DAY(RC[-1]))=1,""0""&TEXT(DAY(RC[-1]),0),TEXT(DAY(RC[-1]),0))"
        .Offset(, 1) = "=IF(LEN(MONTH(RC[-2]))=1,""0""&TEXT(MONTH(RC[-2]),0),TEXT(MONTH(RC[-2]),0))"
        .Offset(, 2) = "=RIGHT(TEXT(YEAR(RC[-3]),0),2)"
        .Offset(, 3) = "=RC[-3]&RC[-2]&RC[-1]"
    End With
End Sub

[/php][/QUOTE]
Code này chỉ thực hiện được ở dòng đầu còn các dòng tiếp theo không chạy được.
Cảm ơn bạn đã giúp mình.

phulien1902 · 24/4/18

huongmuine đã viết:

Có thể làm cách khác:
+ Code Sheet:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$2" Then
        abc
    End If
End Sub
+ Code Module:
[php]
Sub abc()
    With Range("F2:F" & Cells(Rows.Count, 5).End(xlUp).Row)
        .Formula = "=IF(LEN(DAY(RC[-1]))=1,""0""&TEXT(DAY(RC[-1]),0),TEXT(DAY(RC[-1]),0))"
        .Offset(, 1) = "=IF(LEN(MONTH(RC[-2]))=1,""0""&TEXT(MONTH(RC[-2]),0),TEXT(MONTH(RC[-2]),0))"
        .Offset(, 2) = "=RIGHT(TEXT(YEAR(RC[-3]),0),2)"
        .Offset(, 3) = "=RC[-3]&RC[-2]&RC[-1]"
    End With
End Sub

[/php]

Code này chỉ thực hiện được ở dòng đầu còn các dòng tiếp theo không chạy được.
Cảm ơn bạn đã giúp mình.[/QUOTE]
Bạn cứ hay đùa, thử lại lần nữa đi bạn nhé.

huongmuine · 24/4/18

phulien1902 đã viết:
Code này chỉ thực hiện được ở dòng đầu còn các dòng tiếp theo không chạy được.
Cảm ơn bạn đã giúp mình.

Bạn cứ hay đùa, thử lại lần nữa đi bạn nhé.[/QUOTE]
Code này chỉ chạy khi nhập dự liệu vào ô E2.
Do mình copy vào nên code không chạy.
Cảm ơn bạn đã giúp đỡ.

Chúc bạn một ngày vui vẻ.

huongmuine · 24/4/18

hpkhuong đã viết:
Xem lại cú pháp...: chỗ tôi tô màu. Thì biết tại sao???

Cảm ơn bạn đã quan tâm và giúp đỡ.
Chúc bạn một ngày vui vẻ

Ba Tê · 24/4/18

huongmuine đã viết:
Code này chỉ thực hiện được ở dòng đầu còn các dòng tiếp theo không chạy được.

Bạn Format 4 cột F: I kiểu Text rồi thử chạy Sub này xem sao:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range
If Target.Column = 5 Then
    If Target.Columns.Count = 1 Then
        For Each Cll In Target
            With Cll
                If .Value <> Empty Then
                    .Offset(, 1) = Format(Cll, "dd")
                    .Offset(, 2).Value = Format(Cll, "mm")
                    .Offset(, 3).Value = Format(Cll, "yy")
                    .Offset(, 4).Value = Format(Cll, "ddmmyy")
                Else
                    .Offset(, 1).Resize(, 4).ClearContents
                End If
            End With
        Next Cll
    End If
End If
End Sub

huongmuine · 24/4/18

Ba Tê đã viết:

Bạn Format 4 cột D:F kiểu Text rồi thử chạy Sub này xem sao:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range
If Target.Column = 5 Then
    If Target.Columns.Count = 1 Then
        For Each Cll In Target
            With Cll
                If .Value <> Empty Then
                    .Offset(, 1) = Format(Cll, "dd")
                    .Offset(, 2).Value = Format(Cll, "mm")
                    .Offset(, 3).Value = Year(Cll)
                    .Offset(, 4).Value = Format(Cll, "ddmmyy")
                Else
                    .Offset(, 1).Resize(, 4).ClearContents
                End If
            End With
        Next Cll
    End If
End If
End Sub

Cảm ơn Thầy đã giúp.
Chúc Thầy một ngày nhiều niềm vui.

Ba Tê · 24/4/18

huongmuine đã viết:
Cảm ơn Thầy đã giúp.
Chúc Thầy một ngày nhiều niềm vui.

Có nhầm lẫn địa chỉ cột, đã chỉnh lại ở bài trên.
Hoặc thay bằng Sub này, có bẫy lỗi khi nhập "chuỗi ba khơi" vào cột E không phải là Date.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range, Tem As Date
If Target.Column = 5 Then
    If Target.Columns.Count = 1 Then
        For Each Cll In Target
            With Cll
                .Offset(, 1).Resize(, 4).ClearContents
                If .Value <> Empty Then
                    If IsDate(.Value) Then
                        Tem = .Value
                        .Offset(, 1) = Format(Tem, "dd")
                        .Offset(, 2) = Format(Tem, "mm")
                        .Offset(, 3) = Format(Tem, "yy")
                        .Offset(, 4) = Format(Tem, "ddmmyy")
                    End If
                End If
            End With
        Next Cll
    End If
End If
End Sub

truongvu317 · 24/4/18

Ba Tê đã viết:

Bạn Format 4 cột F: I kiểu Text rồi thử chạy Sub này xem sao:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range
If Target.Column = 5 Then
    If Target.Columns.Count = 1 Then
        For Each Cll In Target
            With Cll
                If .Value <> Empty Then
                    .Offset(, 1) = Format(Cll, "dd")
                    .Offset(, 2).Value = Format(Cll, "mm")
                    .Offset(, 3).Value = Format(Cll, "yy")
                    .Offset(, 4).Value = Format(Cll, "ddmmyy")
                Else
                    .Offset(, 1).Resize(, 4).ClearContents
                End If
            End With
        Next Cll
    End If
End If
End Sub

Code này không chạy sai trước thì cũng chạy sai sau, hãy cùng nhau đợi đến ngày nó chạy sai đi.

phulien1902 · 24/4/18

truongvu317 đã viết:
Code này không chạy sai trước thì cũng chạy sai sau, hãy cùng nhau đợi đến ngày nó chạy sai đi.

Bạn muốn nói đến việc định dạng trong cột E?

cuong.vp.nuce · 25/4/18

VBA:
Cho mình hỏi mình có 1 ô A1 dạng text. mình gán ô B2 = A1.
Mình muốn viết hàm code vba lấy giá trị "B2" mà ra được giá trị text của ô A1 được không.
Các bạn giúp mình.

phulien1902 · 26/4/18

cuong.vp.nuce đã viết:
VBA:
Cho mình hỏi mình có 1 ô A1 dạng text. mình gán ô B2 = A1.
Mình muốn viết hàm code vba lấy giá trị "B2" mà ra được giá trị text của ô A1 được không.
Các bạn giúp mình.

Bạn thử:

PHP:

    [a1].Copy
    [b2].PasteSpecial (xlPasteValues)
    [b2].PasteSpecial (xlPasteFormats)

ndu96081631 · 26/4/18

cuong.vp.nuce đã viết:
VBA:
Cho mình hỏi mình có 1 ô A1 dạng text. mình gán ô B2 = A1.
Mình muốn viết hàm code vba lấy giá trị "B2" mà ra được giá trị text của ô A1 được không.
Các bạn giúp mình.

Excel có sẵn hàm này rồi, không cần vba gì đâu.
=INDIRECT("B2") chính là công thức bạn cần

truelove0310 · 26/4/18

Mã:

Private Sub Worksheet_Activate()

    Dim Rng As Range

    Application.ScreenUpdating = False

    For Each Rng In [a6:a10]

        Rng.EntireRow.Hidden = Rng.Value = "0"

    Next Rng

End Sub

Ai giúp mình đoạn code trên với.
với [a6:a10] thì nó hoạt động ok rồi. giờ mình muốn thêm [c26:c36] hoặc thêm nhiều hơn nữa thì làm thế nào ạ.
Mình thử để [a6:c36] thì nó chỉ ẩn hiện [c26:c36] còn [a6:a10] nó không ẩn hiện được được.
Mình cảm ơn trước nhé

ChanhTQ@ · 26/4/18

với [a6:a10] thì nó hoạt động ok rồi. giờ mình muốn thêm [c26:c36] hoặc thêm nhiều hơn nữa thì làm thế nào ạ.
Mình thử để [a6:c36] thì nó chỉ ẩn hiện [c26:c36] còn [a6:a10] nó không ẩn hiện được được.
Mình cảm ơn trước nhé

Duyệt trong 1 cột, thì ô nào thỏa (ĐK) thì cả hàng bị ẩn đi (hay hiện ra)
Duyệt tất thẩy các ô trong ba cột, thì kết quả ẩn hiện sẽ theo ô của cột cuối (là cột 'C' của bạn)
Bảo sao nó làm vậy;
Giờ bạn muốn nó làm khác thì cần nói rõ điều kiện để ẩn hàng khi duyệt lần lượt 3 ô trong hàng đó là sao?

truelove0310 · 26/4/18

ChanhTQ@ đã viết:
Duyệt trong 1 cột, thì ô nào thỏa (ĐK) thì cả hàng bị ẩn đi (hay hiện ra)
Duyệt tất thẩy các ô trong ba cột, thì kết quả ẩn hiện sẽ theo ô của cột cuối (là cột 'C' của bạn)
Bảo sao nó làm vậy;
Giờ bạn muốn nó làm khác thì cần nói rõ điều kiện để ẩn hàng khi duyệt lần lượt 3 ô trong hàng đó là sao?

điều kiện duyệt là giá trị "0" đó bạn.
Mình có 1 bảng có các ô [a6:a10] và [c26:c36] có giá trị độc lập. giờ mình muốn ô nào có giá trị "0" thì ẩn đi ô nào có giá trị thì hiện ra.

HieuCD · 26/4/18

truelove0310 đã viết:
Mã:

Private Sub Worksheet_Activate() Dim Rng As Range Application.ScreenUpdating = False For Each Rng In [a6:a10] Rng.EntireRow.Hidden = Rng.Value = "0" Next Rng End Sub

Ai giúp mình đoạn code trên với.
với [a6:a10] thì nó hoạt động ok rồi. giờ mình muốn thêm [c26:c36] hoặc thêm nhiều hơn nữa thì làm thế nào ạ.
Mình thử để [a6:c36] thì nó chỉ ẩn hiện [c26:c36] còn [a6:a10] nó không ẩn hiện được được.
Mình cảm ơn trước nhé

Bạn dùng thử hàm Union(Range1,Range2,Range3,...)

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 hoạt động

Chuyên gia GPE

Thành viên GPE

File đính kèm

Thành viên GPE

GPE - My love

Thành viên GPE

GPE - My love

Thành viên GPE

Thành viên GPE

Cạo Rồi Khỏi Gội

Thành viên GPE

Cạo Rồi Khỏi Gội

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

GPE - My love

Thành viên mới

GPE - My love

Huyền thoại GPE

Thành viên mới

0901452không62

Thành viên mới

Chuyên gia GPE

Đếm ngược thời gian