Sütün karşılaştırma

[abbasonline]

sitede sütun karşılaştırma ile ilgili örnekler mevcut ancak istediğim, A Sütununa yazmış olduğum 1.....25000' e kadar rakam değişik şekilde yer almakta ve bazende hata ile kimi rakamdan iki tane yazılmaktadır. A sütununda bulunan bu rakamların, (1.....25000' e) arasında atlanılan yazılmayan rakam ve iki defa yazılan rakamları bularak C sütununa yazdırmak istiyorum ( kod ile olursa daha iyi olur, çünkü dosya biraz büyük.)

 

[abbasonline]

Arkadaşlar a ve b sütünlarını karşılaştırıp mükkere olan ve olmayan rakamları c ye yazdırmak istiyorum.

 

[Orion1]

Arkadaşlar a ve b sütünlarını karşılaştırıp mükkere olan ve olmayan rakamları c ye yazdırmak istiyorum.

Sorunuz net değil o yüzden cevap alamamışsınız.
Mükerre olup ve olmayan diyorsunzuz bu durmda hepsi ktarılacak.Ama istediğiniz bu olmamalaı.O zaman copy paste yaparsınız.Siz başka bir şey istiyorsunzu ama onuda net açıklamıyorsunzu.İşte insanlar bu yüzden bu soruya girmiyorlar.Yoksa mükerre kayıtları bulmak çok kolay.Kimse belirsiz sorulara girmek istemez.Bende öyle.Sorularınıza cevap alamıyorsanzı daha açıklayıcı olun ve gerekirse bir tane küçük bir örnek dosya ekleyin.Gördünüzmü bu eksikliğiniz yüzünden bende bir sürü yazı yazdım.Hiç gerek yokken.İyi çalışmalar.:cool.

 

[abbasonline]

Evren bey dosya ekte kusara bakmayın, sorumu tam anlatamamışım.

 

[Orion1]

Dosyanız ektedir.

Sub mukerrer_ve_olamayan()
Dim sat As Long
sat = Cells(65536, "A").End(xlUp).Row
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("D2:E65536").ClearContents
sat2 = 2
For i = 2 To sat
    If WorksheetFunction.CountIf(Range("A2:A" & i), Cells(i, "A").Value) = 1 Then
        If WorksheetFunction.CountIf(Range("A2:A" & sat), Cells(i, "A").Value) > 1 Then
            Cells(sat2, "D").Value = Cells(i, "A").Value
            sat2 = sat2 + 1
        End If
    End If
Next i
sat = Cells(65536, "B").End(xlUp).Row
sat2 = 2
For i = 2 To sat
    If WorksheetFunction.CountIf(Range("B2:B" & i), Cells(i, "B").Value) = 1 Then
        If WorksheetFunction.CountIf(Range("A2:A" & sat), Cells(i, "B").Value) = 0 Then
            Cells(sat2, "E").Value = Cells(i, "B").Value
            sat2 = sat2 + 1
        End If
    End If
Next i

Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbTab & "evrengizlen@hotmail.com", _
vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[abbasonline]

Evren bey yardımınız için teşekkür ederim.

 

[Orion1]

Evren bey yardımınız için teşekkür ederim.

Rica ederim.
İyi çalışmalar.

 

[abbasonline]

EVREN BEY KUSURA BAKMASSANIZ AŞAĞIDAKİ DOSYAYA YARDIMCI OLURMUSUNUZ.

(http://www.excel.web.tr/showthread.php?t=77002)

 

[andon]

Öğrenci Listesi Hazırlama

Merhaba Evren bey
Yukarıdaki örnekte verilen işe benzer ama daha kapsamlı bir makroya ihtiyacım var yardımcı olursanız sevinirim.
Ekte verdiğim tabloda da neler yapılması gerektiğini maddeler halinde anlattım ama aynı maddeleri birde burda yazıyorum.
Yardımcı olursanız çok müteşekkir olurum...

1- Arsiv sayfasında daha önce isimleri yazılan tüm öğrencilere öğrenci kimliği hazırlanmıştır.
2- Yeni Liste sayfasında kimlik çıkartılması için verilen öğrenci isimlerinin listesi vardır.
3- Yeni Listede kimlik çıkarılması istenen öğrencilere daha önce kimlik çıakrılıp/çıkarılmadığını Arsiv sayfasından sorguladıktan sonra, hem Arsiv sayfasında ve hem de Yeni Liste sayfasında ismi geçen öğrenciler, Arsivde Olanlar sayfasına yazdırılmalıdır.
4- 3. Maddenin tam tersi olarak Yeni Liste sayfasında olupta Arsiv sayfasında olmayanlar da Arsivde Olmayan sayfasına yazdırılmalıdır.
5- Sorgulama bir buton yardımı ile başlatılabilir mi?..
6- Sorgulama B sütununda yer alan ÖĞR NO baz alınarak yapılmalıdır.

Saygılarımla

 

[Orion1]

Merhaba Evren bey
Yukarıdaki örnekte verilen işe benzer ama daha kapsamlı bir makroya ihtiyacım var yardımcı olursanız sevinirim.
Ekte verdiğim tabloda da neler yapılması gerektiğini maddeler halinde anlattım ama aynı maddeleri birde burda yazıyorum.
Yardımcı olursanız çok müteşekkir olurum...

1- Arsiv sayfasında daha önce isimleri yazılan tüm öğrencilere öğrenci kimliği hazırlanmıştır.
2- Yeni Liste sayfasında kimlik çıkartılması için verilen öğrenci isimlerinin listesi vardır.
3- Yeni Listede kimlik çıkarılması istenen öğrencilere daha önce kimlik çıakrılıp/çıkarılmadığını Arsiv sayfasından sorguladıktan sonra, hem Arsiv sayfasında ve hem de Yeni Liste sayfasında ismi geçen öğrenciler, Arsivde Olanlar sayfasına yazdırılmalıdır.
4- 3. Maddenin tam tersi olarak Yeni Liste sayfasında olupta Arsiv sayfasında olmayanlar da Arsivde Olmayan sayfasına yazdırılmalıdır.
5- Sorgulama bir buton yardımı ile başlatılabilir mi?..
6- Sorgulama B sütununda yer alan ÖĞR NO baz alınarak yapılmalıdır.

Saygılarımla

Dosyanız ektedir.

Sub tasnifle()
Dim sat1 As Long, sat2 As Long, i As Long, sat As Long, k As Range
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Arsivde Olanlar")
Set s2 = Sheets("Arsivde olmayanlar")
Sheets("Arsiv").Select
Application.ScreenUpdating = False
s1.Range("A2:J65536").Clear
s2.Range("A2:J65536").Clear
sat = Cells(65536, "B").End(xlUp).Row
sat1 = 2
sat2 = 2
With Sheets("Yeni Liste")
    For i = 2 To .Cells(65536, "B").End(xlUp).Row
        Set k = Range("B2:B" & sat).Find(.Cells(i, "B").Value, , xlValues, xlWhole)
        .Range("A" & i & ":J" & i).Copy
        If k Is Nothing Then
            s2.Range("A" & sat2).PasteSpecial
            sat2 = sat2 + 1
            Else
            s1.Range("A" & sat1).PasteSpecial
            sat1 = sat1 + 1
        End If
    Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Tasnif başarı ile yapıldı." & vbLf & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[andon]

Teşekkür Ederim

Çok teşekkür ederim Evren bey
Ben bu kadar erken cevap verdiğiniz ve yardımcı olduğunuz için...
İyi çalışmalar...

 

[Orion1]

Çok teşekkür ederim Evren bey
Ben bu kadar erken cevap verdiğiniz ve yardımcı olduğunuz için...
İyi çalışmalar...

Rica ederim.
İyi çalışmalar.