2 Sütun arasındaki farkları bulmak

[vadimajans]

Merhaba, Elimde bir liste var örnek : 1 den 25 kadar fakat arada eksik sıra var ama bu liste 40 - 50 bin civarında tek tek bunları tespit etmem inanılmaz bir vakit alır aklıma böyle bir ecxel geldi olurmu olmazmı bilmiyorum sol taraftaki orjinal liste sağ taraftaki otomatik oluşan ve eksikliklerin tamamlanmış oldugu bir liste Sol listede 13 ve 14 yoksa yani eksik olan sıra numarası sağ taraftaki listeye bunları ekleyip ilini eklicek ismi BOŞ olucak ve rasgele bir rakam vericek böyle bir şey mümkün müdür bilmiyorum veya derdimi anlata bildimmi

1​	Ayşe	5105100001​	MALATYA			1​	Ayşe	5105100001​	MALATYA
2​	Mehmet	5105100002​	MALATYA			2​	Mehmet	5105100002​	MALATYA
3​	Fatma	5105100003​	MALATYA			3​	Fatma	5105100003​	MALATYA
4​	Ali	5105100004​	MALATYA			4​	Ali	5105100004​	MALATYA
5​	Zeynep	5105100005​	MALATYA			5​	Zeynep	5105100005​	MALATYA
6​	Mustafa	5105100006​	MALATYA			6​	Mustafa	5105100006​	MALATYA
7​	Esra	5105100007​	MALATYA			7​	Esra	5105100007​	MALATYA
8​	Ahmet	5105100008​	MALATYA			8​	Ahmet	5105100008​	MALATYA
9​	Şeyma	5105100009​	MALATYA			9​	Şeyma	5105100009​	MALATYA
10​	Emre	5105100010​	MALATYA			10​	Emre	5105100010​	MALATYA
11​	Hatice	5105100011​	MALATYA			11​	Hatice	5105100011​	MALATYA
12​	Yusuf	5105100012​	MALATYA			12​	Yusuf	5105100012​	MALATYA
15​	Selma	5105100013​	MALATYA			13​	BOŞ	0000000001​	MALATYA
16​	İbrahim	5105100014​	MALATYA			14​	BOŞ	0000000002​	MALATYA
17​	Sevgi	5105100015​	MALATYA			15​	Selma	5105100013​	MALATYA
18​	Can	5105100016​	MALATYA			16​	İbrahim	5105100014​	MALATYA
19​	Sema	5105100017​	MALATYA			17​	Sevgi	5105100015​	MALATYA
20​	Serkan	5105100018​	MALATYA			18​	Can	5105100016​	MALATYA
21​	Elif	5105100019​	MALATYA			19​	Sema	5105100017​	MALATYA
22​	Burak	5105100020​	MALATYA			20​	Serkan	5105100018​	MALATYA
23​						21​	Elif	5105100019​	MALATYA
24​						22​	Burak	5105100020​	MALATYA

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu bir modüle kopyalayıp çalıştırınız.

Sub Test()
    Dim Bak As Long
    Application.ScreenUpdating = False
    For Bak = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Cells(Bak, "A") > Cells(Bak - 1, "A") + 1 Then
            Range("A" & Bak & ":D" & Bak).Insert Shift:=xlDown
            Cells(Bak, "A") = Cells(Bak + 1, "A") - 1
            Cells(Bak, "C") = "123"
            Cells(Bak, "D") = Cells(Bak - 1, "D")
            Bak = Bak + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub