Boş sıra numarası vermek

[hlojan]

Resimdeki örnek gibi data base im var.

field1 ve sirano ikisi bi arada benzersiz kayıt.

İsteğim şu :
BBB için boş sıra numarası istediğim zaman 1,3,4 gibi olduğunda 2 boş numarayı vermesi

AAA içinde mesela 1,2, ya siradaki numara 3 ü vermesi

Dim con As Object, rs As Object
yol = ThisWorkbook.Path & "\DATA.accdb"
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs.Open "select * from [deneme] where field1='" & Worksheets("Veri").Range("c1").Text & "';", con, 1, 1
If rs.RecordCount > 0 Then
 On Error Resume Next
    Worksheets("Veri").Range("c4").Value = ""
    Worksheets("Veri").Range("c4").Value = UCase(Replace(Replace(rs("sirano"), "i", "İ"), "ı", "I"))

    Else
    MsgBox " FİRMA BULUNAMADI"
End If
rs.Close
con.Close
Set rs = Nothing: Set con = Nothing

Ekli dosyada örnek hazırladım yardımlarınızı bekliyorum

 

[hlojan]

Şimdi bi arkadaş yolladı çözüümü. Konu çözümsüz kalmasın

Private Sub CommandButton1_Click()
Dim con As Object, rs As Object
yol = ThisWorkbook.Path & "\DATA.accdb"
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs.Open "select * from [deneme] where field1='" & Worksheets("Veri").Range("c1").Text & "';", con, 1, 1
T1 = 1
If rs.RecordCount > 0 Then
rs.movefirst
Do Until rs.EOF
   If rs!sirano <> T1 Then GoTo 100
   T1 = T1 + 1
   rs.movenext
Loop
100
rs.Close
con.Close
Set rs = Nothing: Set con = Nothing
End If
Worksheets("Veri").Range("c4").Value = T1
End Sub