Kod:
Option Compare Text
Dim sayfaveri
Dim i As Long, kriter1 As String, kriter2 As String
Dim son As Long, j As Byte
Dim arr, scr As Object
arr = Array("K5", "K4", "K6", "A10", "A14", "Y18", "Y19", "A25", "C28", "G41", "G42", "G43", "U43", "U44", "U45")
Application.ScreenUpdating = False
For j = LBound(arr) To UBound(arr)
kriter2 = kriter2 & Worksheets("MUVAFAKAT").Range(arr(j)).Value & "|"
Next
kriter2 = Mid(kriter2, 1, Len(kriter2) - 1)
son = Worksheets("VERÝ").Range("A" & Rows.Count).End(3).Row
For i = 2 To son
For j = 1 To 15
kriter1 = kriter1 & Worksheets("VERÝ").Cells(i, j).Value & "|"
Next
kriter1 = Mid(kriter1, 1, Len(kriter1) - 1)
If kriter1 = kriter2 Then GoTo son
kriter1 = vbNullString
Next
Erase arr
kriter1 = vbNullString
kriter2 = vbNullStringKod:
son:
MsgBox "Mükerrer Kayit", vbCritical, "Mükerrer"
Erase arr
kriter1 = vbNullString
kriter2 = vbNullString
Application.ScreenUpdating = TrueYukarıdaki kodları ekledim.Tamamı altta .Tabii
mantık hatasıda olmuş olabilir tam anlaşılmadığından.Kodunuza bakarak MUVAFAKAT sayfasından veri sayfasına aktarıldığını düşünerek yaptım.
Kod:
Option Compare Text
Sub Makro2()
Dim sayfaveri
Dim i As Long, kriter1 As String, kriter2 As String
Dim son As Long, j As Byte
Dim arr, scr As Object
arr = Array("K5", "K4", "K6", "A10", "A14", "Y18", "Y19", "A25", "C28", "G41", "G42", "G43", "U43", "U44", "U45")
Application.ScreenUpdating = False
For j = LBound(arr) To UBound(arr)
kriter2 = kriter2 & Worksheets("MUVAFAKAT").Range(arr(j)).Value & "|"
Next
kriter2 = Mid(kriter2, 1, Len(kriter2) - 1)
son = Worksheets("VERÝ").Range("A" & Rows.Count).End(3).Row
For i = 2 To son
For j = 1 To 15
kriter1 = kriter1 & Worksheets("VERÝ").Cells(i, j).Value & "|"
Next
kriter1 = Mid(kriter1, 1, Len(kriter1) - 1)
If kriter1 = kriter2 Then GoTo son
kriter1 = vbNullString
Next
Erase arr
kriter1 = vbNullString
kriter2 = vbNullString
say = Worksheets("VERÝ").Range("A65530").End(3).Row + 1
Worksheets("VERÝ").Range("A" & say) = Worksheets("MUVAFAKAT").Range("K5")
Worksheets("VERÝ").Range("B" & say) = Worksheets("MUVAFAKAT").Range("K4")
Worksheets("VERÝ").Range("C" & say) = Worksheets("MUVAFAKAT").Range("K6")
Worksheets("VERÝ").Range("D" & say) = Worksheets("MUVAFAKAT").Range("A10")
Worksheets("VERÝ").Range("E" & say) = Worksheets("MUVAFAKAT").Range("A14")
Worksheets("VERÝ").Range("F" & say) = Worksheets("MUVAFAKAT").Range("Y18")
Worksheets("VERÝ").Range("G" & say) = Worksheets("MUVAFAKAT").Range("Y19")
Worksheets("VERÝ").Range("H" & say) = Worksheets("MUVAFAKAT").Range("A25")
Worksheets("VERÝ").Range("I" & say) = Worksheets("MUVAFAKAT").Range("C28")
Worksheets("VERÝ").Range("J" & say) = Worksheets("MUVAFAKAT").Range("G41")
Worksheets("VERÝ").Range("K" & say) = Worksheets("MUVAFAKAT").Range("G42")
Worksheets("VERÝ").Range("L" & say) = Worksheets("MUVAFAKAT").Range("G43")
Worksheets("VERÝ").Range("M" & say) = Worksheets("MUVAFAKAT").Range("U43")
Worksheets("VERÝ").Range("N" & say) = Worksheets("MUVAFAKAT").Range("U44")
Worksheets("VERÝ").Range("O" & say) = Worksheets("MUVAFAKAT").Range("U45")
Application.ScreenUpdating = True
Exit Sub
son:
MsgBox "Mükerrer Kayit", vbCritical, "Mükerrer"
Erase arr
kriter1 = vbNullString
kriter2 = vbNullString
Application.ScreenUpdating = True
End Sub
