Excel Son numara Bulma ve attırma

[hlojan]

Arkadaşlar günaydın

Firma listem var. Her firmaya ait numaralar var.

her firmaya sürekli yeni numara veriyoruz. en son verdiğimiz numaraya bakarak.

kor firmasına 65 verilmişse 3 numara vererek 68 yapıyoruz

Bunu toparlayarak excel hazırladım

Yapmak istediğim 2. sayfadan numarayı bulsun

kaç numara yazarsam ona eklesin.

Vba kullanmak gerekiyor.


Yardımlarınızı bekliyorum

 

[askm]

Sayfa2 de firma isimleri 1 kere mi geçiyor. Düşeyara ile 65 i buldurmuşsunuz. Burdaki 6-7-8 ne oluyor. 5 numara verilecekse, 1-2-3-4-5 olması gerekmiyor mu? numaralarda; 66,67,68,69,70 olması gerekmiyor mu?

 

[hlojan]

sayfa 2 de firma isimleri benzersiz 1 kere geciyor.

mesala kor 65 de kalmış

5 numara vereceğim . 66 67 68 69 70 yazacak

ve listede kor 70 yazacak

 

[askm]

Aşağıdaki kod işinize yarar mı?

Sub askm()
Dim s1, s2 As Worksheet
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("firma")
adet = Range("B7").Value
Range("I4:T23").ClearContents
sonsayi = Range("D2")
If adet <= 10 Then
    For x = 4 To 22 - (adet * 2) Step 2
        sonsayi = sonsayi + 1
        Cells(x, 9) = sonsayi
    Next x
Else
böl = (adet / 10) + 1
stn = 9
For b = 1 To böl
    For a = 4 To 22 Step 2
        If sonsayi - adet <> Range("D2") Then
            sonsayi = sonsayi + 1
            Cells(a, stn) = sonsayi
        Else
            GoTo 10
        End If
    Next a
stn = stn + 3
Next b
End If
10:
Satir = s2.Columns(1).Find(What:=s1.Range("B2"), After:=s1.Cells(2, 1), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
s2.Cells(Satir, "B") = sonsayi
End Sub