Option Explicit
Sub SoSánh()
Const Tm As String = "*"
Dim Rng As Range, Cls As Range, WF As Object, sRng As Range
Dim Rg0 As Range, Cll As Range
Dim MyAdd As String
Dim FTr As Double, jJ As Byte
Set WF = Application.WorksheetFunction
For Each Cls In Range([A1], [A65500].End(xlUp))
If Cls.Value = "%" Then
Set Rng = Range(Cls, Cells(Cls.Row, "IU").End(xlToLeft).Offset(, 1))
FTr = WF.Max(Rng)
If FTr > 0.95 Then
Set Rng = Rng.Offset(1)
Rng(1).Offset(, Rng.Count - 1).Value = Tm
Set sRng = Rng.Find(Tm, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
If Not Intersect(Rng, sRng.End(xlToRight)) Is Nothing Then
Set Rg0 = Range(sRng, sRng.End(xlToRight).Offset(, -1))
Else
Exit Do
End If
For jJ = 2 To Rg0.Count
If Rg0(1).Offset(-2).Value > Rg0(jJ).Offset(-2) Then
Rg0(1).Offset(-2).Value = CStr(Rg0(1).Offset(-2).Value) & Left(Right(Rg0(jJ).Offset(-3), 2), 1)
Else
Rg0(jJ).Offset(-2).Value = CStr(Rg0(jJ).Offset(-2).Value) & Left(Right(Rg0(1).Offset(-3), 2), 1)
End If
Next jJ
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Else
MsgBox "No", , Cls.Address
End If
End If
Next Cls
End Sub
òng GIATRI so sánh từ cột bắt đầu có dấu * và kết thúc bằng dấu * VD như trên thì sẽ so sánh 6 với 34 ; 32 so sánh với 7 và 3 so sánh với 7 ; 53 so sánh với 4 ; 5 so sánh với 4 ; 34 so với 64
