sutunlar arası karşılaştırma

[miromax]

merhaba ustalar eklediğim dosyada a da olupta b de olmayanları c de sıralamak istiyorum ancak a ve b dekiler sıralı değil yardımcı olabilirmisiniz karışık olmasına rağmen c ye a da olupta b de olmayanları ara boşluklarıyla getirebilirmi sıralama bozulmadan.

teşekkür ederim.

 

[Orion1]

Dosyanız ektedir.

Sub olmayanlar59()
Dim i As Long, sat1 As Long, sat2 As Long, sat3 As Long
Range("C:C").ClearContents
Application.ScreenUpdating = False
sat1 = Cells(Rows.Count, "A").End(xlUp).Row
sat2 = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To sat2
    If WorksheetFunction.CountIf(Range("A1:A" & sat1), Cells(i, "B").Value) = 0 Then
        sat3 = sat3 + 1
        Cells(sat3, "C").Value = Cells(i, "B").Value
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName
   
End Sub

 

[miromax]

Dosyanız ektedir.

Sub olmayanlar59()
Dim i As Long, sat1 As Long, sat2 As Long, sat3 As Long
Range("C:C").ClearContents
Application.ScreenUpdating = False
sat1 = Cells(Rows.Count, "A").End(xlUp).Row
sat2 = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To sat2
    If WorksheetFunction.CountIf(Range("A1:A" & sat1), Cells(i, "B").Value) = 0 Then
        sat3 = sat3 + 1
        Cells(sat3, "C").Value = Cells(i, "B").Value
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName
   
End Sub

çok teşekkürler,a da olmayıp b de olanlar c de görünüyor ancak c ye aktardığı liste b nin sıralaması bozulmadan ara boşluklarla c de görünebilirmi.yardımcı olabilirmisin.

 

[Ziynettin]

Merhaba,
Sayın, Orion1 hocamızın yazmış olduğu kodun revize edilmiş durumu.

Sub olmayanlar59()
Dim i As Long, sat1 As Long, sat2 As Long, sat3 As Long
Range("C:C").ClearContents
Application.ScreenUpdating = False
sat1 = Cells(Rows.Count, "A").End(xlUp).Row
sat2 = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To sat2
    If WorksheetFunction.CountIf(Range("A1:A" & sat1), Cells(i, "B").Value) = 0 Then
        Cells(i, "C").Value = Cells(i, "B").Value
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName
   
End Sub