Code VBA So sánh cột (1 người xem)

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

thungdols

Thành viên chính thức
Tham gia
27/3/09
Bài viết
66
Được thích
2
Đây là code của bác SA_DQ. về việc so sánh cột. Nhưng em muốn biến dổi 1 chút. Nhưng sao nó chạy không nổi. Em mới chập chững với VBA. mông mọi người giúp em.}}}}}}}}}}}}}}}
Sub SoTrung()
Dim Sh As Worksheet, Rng As Range, Clls As Range
Dim Rw As Long, Col As Byte, Jj As Byte, Dem As Long, MyColor As Byte
Dim Cll As Range, Rng1 As Range, Rng2 As Range
Dim Row As Long, Ii As Integer

Sheets("B1").Select: Set Sh = Sheets("B2")
Sh.Cells.Interior.ColorIndex = 0: Cells.Interior.ColorIndex = 0
Rw = Sh.UsedRange.Rows.Count
Application.ScreenUpdating = False
Col = [A1].CurrentRegion.Columns.Count
Row = [A1].CurrentRegion.Rows.Count
For Ii = 1 To Row
Set Rng = Cells(Ii 1, 1).Resize(, Col)

For Each Clls In Rng
With Application.WorksheetFunction
For Jj = 1 To Col
Set Rng1 = Clls.Resize(Ii - 1 Rw)
Set Rng2 = Sh.Cells(1, Jj).Resize(Rw)
If .Sum(Rng1) = .Sum(Rng2) Then
Dem = 0
For Each Cll In Rng1
Dem = Dem 1
If Cll.Value Rng2.Cells(Dem, 1).Value Then Exit For
Next Cll
If Dem = Rw Then
MyColor = 34 Clls.Column Mod 6
Clls.Interior.ColorIndex = MyColor
Sh.Cells(1, Jj).Interior.ColorIndex = MyColor
End If
End If
Next Jj
End With
Next Clls
Next Ii
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
sao code lúc chạy lúc không chạy vây ta? - - - - - - - - - - - -

Sub SoTrung()
Dim Sh As Worksheet, Rng As Range, Clls As Range
Dim Rw As Long, Col As Byte, Jj As Byte, Dem As Long, MyColor As Byte
Dim Cll As Range, Rng1 As Range, Rng2 As Range
Dim Row As Long, Ii As Integer
Sheet3.Activate
Range("A3:IV1100").Select
Selection.ClearContents

Sheets("B1").Select: Set Sh = Sheets("B2")
Sh.Cells.Interior.ColorIndex = 0: Cells.Interior.ColorIndex = 0
Rw = Sh.UsedRange.Rows.Count
Application.ScreenUpdating = False
Col = [A1].CurrentRegion.Columns.Count
Row = [A1].CurrentRegion.Rows.Count
For Ii = 1 To Row
Set Rng = Cells(Ii 1, 1).Resize(, Col)
For Each Clls In Rng
With Application.WorksheetFunction
For Jj = 1 To Col
Set Rng1 = Clls.Resize(Rw)
Set Rng2 = Sh.Cells(1, Jj).Resize(Rw)
If .Sum(Rng1) = .Sum(Rng2) Then
'If Sheet1.Cells(Ii Rw 1, Clls.Column).Value = 1 Then
Dem = 0
For Each Cll In Rng1
Dem = Dem 1
If Cll.Value Rng2.Cells(Dem, 1).Value Then Exit For
Next Cll
If Dem = Rw Then
MyColor = 34 Clls.Column Mod 6
Clls.Interior.ColorIndex = MyColor
Sh.Cells(1, Jj).Interior.ColorIndex = MyColor
Sheet3.Cells(Ii 1, Jj).Value = Jj - 1
End If
'End If
End If
Next Jj
End With
Next Clls
Next Ii
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0

Bài viết mới nhất

Back
Top Bottom