VBA kullanarak hücreler içinden belirli değer ile başlayan veriyi arayıp bulduğunda A1 den başlayarak alt alta sıralama

[ayhanycelik]

Excelde A100:ABC100 hücreleri boyunca "Barkod No:" ile başlayan veriyi arayıp bulma ve bulduğu her "Barkod No:" ile başlayan hücre değerini A1 den başlayarak alt alta sıralamak istiyorum. mümkünmüdür

 

[Korhan Ayhan]

Denemek isterseniz formül ile çözüm üretilebilir..

DİZİ formüldür.

=İNDİS($A$100:$ABC$100;;KÜÇÜK(EĞER(SOLDAN($A$100:$ABC$100;UZUNLUK("Barkod No:"))="Barkod No:";SÜTUN($A$100:$ABC$100));SATIR()))

 

[ayhanycelik]

Merhaba @korhan bey VBA da olsa süper olaca zira datayı vba ile sayfaya çektim sadece veriyi aratıp A1 den itibaren alt alta her bulduğu değeri sıralaması gerekiyor orada takıldım

 

[Korhan Ayhan]

Belirttiğiniz aralıkta 731 hücre bulunuyor. Ve bu hücrelerde A sütunuda var. Listenin A sütununda oluşmasını istiyorsunuz. Bir çakışma durumu var. Eğer listelenecek veri sayısı 100 satırı aşarsa A100 hücresinde bulunan veri silinecektir. Bu durumu gözönüne alarak gerekirse kodu revize edersiniz.

Option Explicit

Sub Barkod_Listele()
    Dim Alan As Range, Bul As Range, Adres As String, Satir As Integer
    
    Set Alan = Range("A100:ABC100")
    
    Range("A1:A99").ClearContents
    
    Set Bul = Alan.Find("Barkod No:", , , xlPart)
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
            Satir = Satir + 1
            Cells(Satir, 1) = Bul.Value
            Set Bul = Alan.FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ayhanycelik]

Merhaba @Korhan Ayhan bey bir sorum olacaktı yukarıdaki arama çok işime yaradı ancak; arama esnasında kalibrasyon testinde akan "Barkod No:000000" verileri de geliyor ben bol sıfırlı bu değerleri çekmesini istemiyorum kodu nasıl revize edebilirmiyim, aramada bulduğu değeri (Barkod No:000000) ise atlatmak istiyorum

 

[Korhan Ayhan]

Merhaba,

Bir önceki mesajımda belirttiğim adres çakışmasını düzenlemişsiniz. Aranacak alanı B100:ABC100 olarak düzenlemişsiniz.

Deneyiniz.

Option Explicit

Sub Barkod_Listele()
    Dim Alan As Range, Bul As Range, Adres As String, Satir As Integer
    
    Set Alan = Range("B100:ABC100")
    
    Range("A:A").ClearContents
    
    Set Bul = Alan.Find("Barkod No:", , , xlPart)
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
            If Bul.Value <> "Barkod No:000000" Then
                Satir = Satir + 1
                Cells(Satir, 1) = Bul.Value
                Set Bul = Alan.FindNext(Bul)
            End If
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ayhanycelik]

çok teşekkür ederim

 

[ayhanycelik]

Merhaba @Korhan Ayhan bey; sitede aradım ancak çok aşikar olmadığım için ulaşamadım sanırım, A1:A5000 hücre aralığında bir dizi verim var ve bu verilere karşılık B1:B5000 aralığında karşılık değerim var, ancak A1:A5000 aralığında bazı veriler tekrar ediyor ancak tekrar eden verilerin karşışığı olan B1:B5000 aralığı da farklılı hücre değeri olanlar mevcut, yapmak istediğim A1:A5000 aralığındaki tekrar eden değerlerden B1:B5000 aralığında farklı olanlar varsa onları bulup alt alta sıralamak istiyorum mümkünmüdüdür Örnek verirsem, A1 ve A2 hüresinde ALİ yazıyor ve B1 ve B2 de UZAN yazıyor bu iki yada daha fazla hücrede aynı ise listelemesin ancak; A1 ve A2 deALİ yazıyor ve B1 de UZAN B2 de UZ yazıyorsa bu iki değeri farklı hücrede (D1 de ALİ , E1de UZAN yazsın ve D2de ALİ , E2' de UZAN yazssın gibi) alt alata sıralasın bunu 5000 hücreyi tarayarak yapsın

 

[Korhan Ayhan]

Aşağıdaki iki kodu deneyiniz. Hangisi işinize yararsa onu kullanırsınız.

Option Explicit

Sub Benzersiz_Liste_Ado()
    Dim My_Connection As Object, My_Recordset As Object, Zaman As Double

    Zaman = Timer
 
    Range("D:E").Clear

    Set My_Connection = VBA.CreateObject("AdoDb.Connection")

    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Set My_Recordset = My_Connection.Execute("Select F1,F2 From [Sheet1$] Group By F1,F2 Having Count(F1) = 1 And Count(F2) = 1")
 
    Range("D1").CopyFromRecordset My_Recordset
 
    If My_Connection.State <> 0 Then My_Connection.Close
 
    Set My_Connection = Nothing
    Set My_Recordset = Nothing
 
    MsgBox "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

Option Explicit

Sub Tekrarsiz_Liste_Ado()
    Dim My_Connection As Object, My_Recordset As Object, Zaman As Double

    Zaman = Timer
 
    Range("D:E").Clear

    Set My_Connection = VBA.CreateObject("AdoDb.Connection")

    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Set My_Recordset = My_Connection.Execute("Select Distinct F1,F2 From [Sheet1$]")
 
    Range("D1").CopyFromRecordset My_Recordset
 
    If My_Connection.State <> 0 Then My_Connection.Close
 
    Set My_Connection = Nothing
    Set My_Recordset = Nothing
 
    MsgBox "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[ÖmerFaruk]

Sayın @ayhanycelik
Aynı soruyu farklı başlıklarda farklı şekillerde sorduğunuzda hem siz hem biz gereğinden fazla uğraşıyoruz.
Sanırım aynı soru diğer başlığınızda 2 farklı şekilde çözüme kavuşturuldu.

 

[ayhanycelik]

@ÖmerFaruk bey haklısnız , lakin yeni başlık açmamdaki düşüncem bu başlıkta arama yapacak olan kişilere zorluk çıkarmamak istememdi. daha dikkatli olacağım. iyiki varsınız