Code chạy báo lỗi! Mong Anh Hữu Thắng Giúp đỡ em

[thungdols]

code của anh Thắng chạy ngon. Em chỉ sửa có tí xíu. Nó chạy vẫn bình thường nhưng đến dòng này thì không thấy chạy. Em không hiểu nó bị lỗi cái gì nữa mong Anh giúp đỡ em. - - - - - - - - -

 

[huuthang_bd]

code của anh Thắng chạy ngon. Em chỉ sửa có tí xíu. Nó chạy vẫn bình thường nhưng đến dòng này thì không thấy chạy. Em không hiểu nó bị lỗi cái gì nữa mong Anh giúp đỡ em.

Bạn sửa lại như thế này:

Sub GPE()
Application.ScreenUpdating = False
Dim EndR As Long, Cll As Range, FCll As Range, FCllAdd As String, iCll As Range, Arr(), i As Long
Result.[C6:AC65536].ClearContents
Set Cll = Data.[C:AC].Find("*", Data.[C1], , , 1, 2)
If Cll Is Nothing Then Exit Sub
EndR = Cll.Row - 4
If EndR < 2 Then Exit Sub
For Each Cll In Result.[C2:AC2]
    Set FCll = Data.[C1]
    i = 0
    Do Until Data.Range("C" & (FCll.Row + 1) & ":AC" & EndR).Find(Cll.Value, Data.Range("AC" & EndR), xlValues, 1, 1, 1) Is Nothing Or FCll.Row = EndR
        Set FCll = Data.Range("C" & (FCll.Row + 1) & ":AC" & EndR).Find(Cll.Value, Data.Range("AC" & EndR), xlValues, 1, 1, 1)
        If WorksheetFunction.CountIf(Data.Cells(FCll.Row + 1, 3).Resize(, 27), Cll.Offset(1)) > 0 Then
            i = i + 1
            ReDim Preserve Arr(1 To i)
            Arr(i) = FCll.Row + 2
        End If
    Loop
    If i = 0 Then GoTo NextCll
    For Each iCll In Data.Cells(Arr(1), 3).Resize(3, 27)
        For i = 2 To UBound(Arr)
            If Data.Cells(Arr(i), 3).Resize(3, 27).Find(What:=iCll.Value, LookAt:=xlWhole) Is Nothing Then
                GoTo NextiCll
            End If
        Next
        Cll.Offset(65534).End(xlUp).Offset(1).Value = iCll.Value
NextiCll:
    Next
NextCll:
Next
Application.ScreenUpdating = True
End Sub

 

[thungdols]

cám ơn anh nhiều lắm. Code da chạy ngon rồi anh ah