Hỏi? Làm thế nào khi thay đổi giá trị 1 ô nào đó code sẽ hoạt động! (1 người xem)

[vova2209]

Em có đoạn code dưới đây nếu 1 ô nào đó thay đổi giá trị thì code sẽ hoạt động..
mong được giúp đỡ!
-------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub

 

[langtuchungtinh360]

Em có đoạn code dưới đây nếu 1 ô nào đó thay đổi giá trị thì code sẽ hoạt động..
mong được giúp đỡ!
-------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub

thêm cái đoạn này nữa nhé

Dim txt

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
txt = Target.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Value <> txt Then

        'code cua ban
    End If

End Sub

 

[vova2209]

Không hoạt động anh à! báo Debug
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim txt
txt = Target.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value <> txt Then
'------------------------------------
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub

'code cua ban
End If
End Sub
--------------------

thêm cái đoạn này nữa nhé

Dim txt

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
txt = Target.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Value <> txt Then

        'code cua ban
    End If

End Sub

 

[langtuchungtinh360]

Không hoạt động anh à! báo Debug
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim txt
txt = Target.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value <> txt Then
'------------------------------------
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub

'code cua ban
End If
End Sub
--------------------

hết chuyện bạn dán code đó vào bên trong code của bạn sao chạy được

Dim txt As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
txt = Target.Cells(1, 1).Value2
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Value <> txt Then
        '------------------------------------
    Dim NewRwHt As Single
    Dim cWdth As Single, MrgeWdth As Single
    Dim c As Range, cc As Range
    Dim ma As Range
        With Target
            If .MergeCells And .WrapText Then
                Set c = Target.Cells(1, 1)
                cWdth = c.ColumnWidth
                Set ma = c.MergeArea
                For Each cc In ma.Cells
                    MrgeWdth = MrgeWdth + cc.ColumnWidth
                Next
                Application.ScreenUpdating = False
                ma.MergeCells = False
                c.ColumnWidth = MrgeWdth
                c.EntireRow.AutoFit
                NewRwHt = c.RowHeight
                c.ColumnWidth = cWdth
                ma.MergeCells = True
                ma.RowHeight = NewRwHt
                cWdth = 0: MrgeWdth = 0
                Application.ScreenUpdating = True
            End If
        End With
    End If
End Sub

copy hết code này rồi dán đè vào code cũ của bạn nhé, tức là xóa code cũ của bạn đi rồi dán code mới này vào

 

[vova2209]

hết chuyện bạn dán code đó vào bên trong code của bạn sao chạy được

Dim txt As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
txt = Target.Cells(1, 1).Value2
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Value <> txt Then
        '------------------------------------
    Dim NewRwHt As Single
    Dim cWdth As Single, MrgeWdth As Single
    Dim c As Range, cc As Range
    Dim ma As Range
        With Target
            If .MergeCells And .WrapText Then
                Set c = Target.Cells(1, 1)
                cWdth = c.ColumnWidth
                Set ma = c.MergeArea
                For Each cc In ma.Cells
                    MrgeWdth = MrgeWdth + cc.ColumnWidth
                Next
                Application.ScreenUpdating = False
                ma.MergeCells = False
                c.ColumnWidth = MrgeWdth
                c.EntireRow.AutoFit
                NewRwHt = c.RowHeight
                c.ColumnWidth = cWdth
                ma.MergeCells = True
                ma.RowHeight = NewRwHt
                cWdth = 0: MrgeWdth = 0
                Application.ScreenUpdating = True
            End If
        End With
    End If
End Sub

copy hết code này rồi dán đè vào code cũ của bạn nhé, tức là xóa code cũ của bạn đi rồi dán code mới này vào

Vâng em cảm ơn ạ! ok rồi a