makro ile sayıların sıra takibi;

[abbasonline]

Makro ile arada olmayan rakamları veyahut mükerrerleri bulma

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki linkleri incelermisiniz.

Aradaki eksiği bulmak..
Seri no daki eksik tespit hk.
eksik sıra no bulma
Sıralı sayılarda eksik sayıları listeleme ?
Eksİk Rakamlari Bulma
eksik rakamları bulma

 

[asi_kral]

Makro ile arada olmayan rakamları veyahut mükerrerleri bulma

Merhaba
Kodu boş bir module kopyalayıp dener misiniz_?

Option Explicit
Sub Sırada_Mükerrer_Olmayan_1967()
'Konu       :   Sıra Numarası Olmayanları ve Mükerrer Olanları Yaz
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Worksheet, kral As Worksheet, _
a As Long, b As Long, c As Long, d As Variant, e As Variant
Set asi = Sheets("TÜM"): Set kral = Sheets("SAYISAL")
Application.ScreenUpdating = False
For a = 5 To kral.Range("B" & Rows.Count).End(xlUp).Row
kral.Range("H:H").ClearContents
c = 1: d = Empty: e = Empty
For b = 7 To asi.Range("C" & Rows.Count).End(xlUp).Row
If WorksheetFunction.Proper(asi.Cells(b, "C")) = _
WorksheetFunction.Proper(kral.Cells(a, "B")) Then
kral.Cells(c, "H") = asi.Cells(b, "G")
c = c + 1: End If: Next
For c = 1 To kral.Cells(Rows.Count, "H").End(xlUp).Row
If WorksheetFunction.CountIf(kral.Range("H1:H" & c), kral.Cells _
(c, "H")) > 1 Then
If d = Empty Then
d = d & kral.Cells(c, "H").Text
Else
d = d & " , " & kral.Cells(c, "H").Text
End If: End If: Next
kral.Cells(a, "C") = d
For c = 1 To WorksheetFunction.Max(kral.Range("H:H"))
If WorksheetFunction.CountIf(kral.Range("H:H"), c) = 0 Then
If e = Empty Then
e = e & c & ""
Else
e = e & " , " & c & ""
End If: End If: Next: kral.Cells(a, "D") = e: Next
kral.Range("H:H").ClearContents
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

 

[abbasonline]

tEŞEKKÜRLER, ELLERİNİZE SAĞLIK

 

[abbasonline]

asi_kral_1967, yazmış olduğunuz makro çok güzel çalışıyor ancak, sayısal sayfada mükerrerleri D satırı yerine DW satırından, bulunmayan numaralarıda E satırı yerine DX satırından itibaren yazması için nasıl düzenleme yapmam gerekli, teşekkürler.

 

[abbasonline]

Gerek kalmadı halledebildim, teşekkürler.

 

[asi_kral]

Gerek kalmadı halledebildim, teşekkürler.

Kolay Gelsin.