aynı verilerin karşısına aynı rakamları yazma

[ifade28]

merhaba arkadaşlar excelde bi sronum var aynı yazan hucrelerın karsı hucresıne aynı sayıları nasıl gırebılırım

ahmet 45
ali 50
ahmet 45
mehmet 18

gibi

 

[Korhan Ayhan]

Sayılar neye göre belirleniyor?

 

[ifade28]

barkod şeklinde olacak ama kafamıza gorede otomatık numara verebılır ama 5 hanelı falan

 

[Korhan Ayhan]

Örnek dosya paylaşır mısınız?

 

[ifade28]

nasıl yukleyecegım yuklenecek yer yok

 

[ifade28]

resım yuklesem

 

[ifade28]

https://i.hizliresim.com/VQZkOR.png

 

[Korhan Ayhan]

Linke yükleyebilirsiniz.

WeTransfer | Send Large Files Fast - Up To 2GB Free

The simple, quick and secure way to send your files around the world without an account. Share your files, photos, and videos today for free.

wetransfer.com

 

[ifade28]

mail adresi lazım

 

[ifade28]

sanırım yaptım

deneme.xlsx

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[Korhan Ayhan]

İsterseniz makro ile 5 karakterli sayısal veriler üretilebilir.

Harici Link (Silinebilir) ; https://we.tl/t-fxFmOqCesg

Option Explicit

Sub Barkod_Olustur()
    Dim X As Long, Son As Long, Barkod As Long, Liste As Variant
    Dim Dizi As Object, Urun_Bul As Range, Adres As String
   
    Application.ScreenUpdating = False
   
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    Range("B2:B" & Rows.Count).ClearContents
   
    Son = Cells(Rows.Count, 1).End(3).Row
    Liste = Range("A2:A" & Son).Value
   
    For X = LBound(Liste) To UBound(Liste)
        If Cells(X, 2) = "" Then
10          Barkod = WorksheetFunction.RandBetween(10000, 99999)
            If Not Dizi.Exists(Barkod) Then
                Dizi.Add Barkod, Nothing
                Cells(X, 2) = Barkod
                Set Urun_Bul = Range("A:A").Find(Cells(X, 1), , , xlWhole)
                If Not Urun_Bul Is Nothing Then
                    Adres = Urun_Bul.Address
                    Do
                        Urun_Bul.Offset(0, 1) = Barkod
                        Set Urun_Bul = Range("A:A").FindNext(Urun_Bul)
                        X = Urun_Bul.Row - 1
                    Loop While Not Urun_Bul Is Nothing And Adres <> Urun_Bul.Address
                End If
            Else
                GoTo 10
            End If
        End If
    Next

    Set Urun_Bul = Nothing
    Set Dizi = Nothing

    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ifade28]

çözüldü teşekkür ederim