Chuyên mục xử lý, gỡ rối code VBA

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

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.

hpkhuong · 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.

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

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,...)

truelove0310 · 26/4/18

HieuCD đã viết:
Bạn dùng thử hàm Union(Range1,Range2,Range3,...)

Oh. đúng là mừ chữ có khác. mò hoài không ra
Cảm ơn bản đã chỉ nhé. Ok rồi!

batman1 · 26/4/18

truelove0310 đã viết:
đ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.

Nếu tôi hiểu ý thì

Mã:

Private Sub Worksheet_Activate()

    Dim Rng As Range, resRng As Range

    Application.ScreenUpdating = False
    Range("a6:a10, c26:c36").EntireRow.Hidden = False
 
    For Each Rng In Range("a6:a10, c26:c36")
        If Rng.Value = 0 Then
            If resRng Is Nothing Then
                Set resRng = Rng
            Else
                Set resRng = Union(resRng, Rng)
            End If
        End If
    Next Rng
    If Not resRng Is Nothing Then resRng.EntireRow.Hidden = True
End Sub

Thậm chí nếu bạn chỉ có 1 khoảng trong 1 cột nhưng là hàng nghìn dòng thì cũng nên dùng UNION như trên. Ngược lại có thể chờ mỏi mắt mới thấy cập nhật.

Tức không UNION "a6:a10" và "c26:c36" mà ý tôi nói về UNION khác. Nếu dư liệu nhiều thì tuyệt đối cấm ẩn / hiện từng dòng. Vì ccó thể phải đi uống cà phê.

truelove0310 · 26/4/18

batman1 đã viết:
Nếu tôi hiểu ý thì

Mã:

Private Sub Worksheet_Activate() Dim Rng As Range, resRng As Range Application.ScreenUpdating = False Range("a6:a10, c26:c36").EntireRow.Hidden = False For Each Rng In Range("a6:a10, c26:c36") If Rng.Value = 0 Then If resRng Is Nothing Then Set resRng = Rng Else Set resRng = Union(resRng, Rng) End If End If Next Rng If Not resRng Is Nothing Then resRng.EntireRow.Hidden = True End Sub

Thậm chí nếu bạn chỉ có 1 khoảng trong 1 cột nhưng là hàng nghì dòng thì cũng nên dùng UNION như trên. Ngược lại có thể chờ mỏi mắt mới thấy cập nhật.

batman1 đã viết:
Nếu tôi hiểu ý thì

Mã:

Private Sub Worksheet_Activate() Dim Rng As Range, resRng As Range Application.ScreenUpdating = False Range("a6:a10, c26:c36").EntireRow.Hidden = False For Each Rng In Range("a6:a10, c26:c36") If Rng.Value = 0 Then If resRng Is Nothing Then Set resRng = Rng Else Set resRng = Union(resRng, Rng) End If End If Next Rng If Not resRng Is Nothing Then resRng.EntireRow.Hidden = True End Sub

Thậm chí nếu bạn chỉ có 1 khoảng trong 1 cột nhưng là hàng nghìn dòng thì cũng nên dùng UNION như trên. Ngược lại có thể chờ mỏi mắt mới thấy cập nhật.

Tức không UNION "a6:a10" và "c26:c36" mà ý tôi nói về UNION khác. Nếu dư liệu nhiều thì tuyệt đối cấm ẩn / hiện từng dòng. Vì ccó thể phải đi uống cà phê.

code của bạn khó dùng quá. với những người không hiểu về lập trình như tôi thì càng đơn giản càng dễ dùng bạn ạ! cảm ơn bạn nhiều nhé.

Chuyên mục xử lý, gỡ rối code VBA

Huyền thoại 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

Thành viên mới

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

Thành viên mới

Facebook

Group