Farklı 2 sayfadaki kayıtları bulma,

Katılım
2 Ocak 2022
Mesajlar
47
Excel Vers. ve Dili
2016 Türkçe
Merhaba,
Excel sayfa1'de aktif siparişler, sayfa2'de iptal olan sipariş kayıtları var. Kayıtlar 7 sütunda. Aynı sipariş içerisinde birden fazla ürün olduğu için aynı kodlu birden fazla satır mevcut.
Textbox1 den aratacağım sipariş kodları sayfaların A sütununda. Yapılmak istenen
kayıt hangi sayfada ve kaç tane ise bulunup, listbox1 içerisinde görüntülemek ve sayfa1 de bulmuş ise textbox2 de AKTİF, sayfa2 de bulmuş ise textbox2 de İPTAL yazması.
Düzgün bir başlangıç yapamadım. Teşekkürlerimle.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Örnek dosya ekleyerek dosya içerisinde konuyu daha detaylı açıklar mısınız.

 
Katılım
2 Ocak 2022
Mesajlar
47
Excel Vers. ve Dili
2016 Türkçe
Ömer Bey merhaba,
özerinde değişiklik yapmak istediğim makro ekte. Mevcut açıklama sayfa1 de ekli. İlginiz için çok teşekkür ederim.

 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Sipariş numarasını sayfalarda arama yaparken, iki sayfada da aynı anda olma ihtimali yok sanırım? Aşağıdaki açıklamanızdan o şekilde anladım.
Eğer iki sayfada da olma ihtimali varsa Label15 ne olacak?
Yada iki sayfada da bulamazsa Label15 ne olacak?

Textbox1 de bu kez sipariş numaralarını SAYFA1 ve SAYFA2 de arayacak, bulduğu kayıtları LİSTBOX1 de listeleyecek. LABEL15 de ise SAYFA1 de bulmuş ise AKTİF, SATFA2 de bulmuş ise İPTAL uyarısı verecek.
 
Katılım
2 Ocak 2022
Mesajlar
47
Excel Vers. ve Dili
2016 Türkçe
Sipariş numarasını sayfalarda arama yaparken, iki sayfada da aynı anda olma ihtimali yok sanırım? Aşağıdaki açıklamanızdan o şekilde anladım.
Eğer iki sayfada da olma ihtimali varsa Label15 ne olacak?
Yada iki sayfada da bulamazsa Label15 ne olacak?
Doğru anlamışsınız. Sipariş Numarası tek. Label15 de siparişin durumu belli olacak. Sayfa1 de bulur ise Aktif, yani tamamlanan sipariş, sayfa2 de bulursa iptal olan sipariş olduğu ilk anda görülebilecek. Bulunamaz ise sipariş kaydı yok yazacak Label15 de.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Kodlarını biraz düzenleyip konuyu anladığım kadarıyla yazmaya çalıştım.
Örneğin 200 değeri sayfa2 de birden fazla var, sizin kodlar ilk gördüğünü alıyordu, bende öyle bıraktım. Bu durum değişecek miydi.
TextBox1_AfterUpdate kodlarını aşağıdakilerle değiştirerek deneyiniz.

Kod:
Private Sub TextBox1_AfterUpdate()

    Dim syf(), j As Byte, i As Integer, s As Byte, c As Range, S1 As Worksheet

    syf = Array("Sayfa1", "Sayfa2")
    
    bul = TextBox1
    
    For j = 0 To UBound(syf)
        Set S1 = Sheets(syf(j))
        Set c = S1.[A:A].Find(bul, , xlValues, xlWhole)
        If Not c Is Nothing Then
        
            barkod = S1.Cells(c.Row, "A")
            urun = S1.Cells(c.Row, "B")
            urunf = S1.Cells(c.Row, "C")
            Alis = S1.Cells(c.Row, "D")
            Yuzde = S1.Cells(c.Row, "E")
            Kategori = S1.Cells(c.Row, "F")
            
            adet = TextBox5
            tutar = adet * urunf
            TextBox3.Text = FormatCurrency(tutar, 2)
            TextBox2.Text = barkod & " - " & urun
            TextBox6.Text = FormatCurrency(urunf, 2)
            
            With ListBox1
                .AddItem
                .List(.ListCount - 1, 0) = barkod
                .List(.ListCount - 1, 1) = urun
                .List(.ListCount - 1, 2) = FormatCurrency(urunf, 2)
                .List(.ListCount - 1, 3) = adet
                .List(.ListCount - 1, 4) = FormatCurrency(tutar, 2)
                .List(.ListCount - 1, 5) = Alis
                .List(.ListCount - 1, 6) = Yuzde
                .List(.ListCount - 1, 7) = Kategori
                
                For i = 0 To .ListCount - 1
                    topla4 = CDbl(.List(i, 4)) + CDbl(topla4)
                    topla5 = CDbl(Val(.List(i, 3))) + CDbl(Val(topla5))
                Next i

                TextBox4.Text = FormatCurrency(topla4, 2)

                Label14 = topla5
                .Selected(.ListCount - 1) = True
        
                TextBox1 = ""
                TextBox2 = ""
                TextBox3 = ""
                TextBox6 = ""
                TextBox5 = 1
                TextBox1.SetFocus
            End With
            
            If S1.Name = syf(0) Then
                Label15 = "AKTİF"
            Else
                Label15 = "İPTAL"
            End If
        
            s = 1
            Exit For
        End If
    Next j
    
    If s = 0 Then
        MsgBox "Ürün Kayıtlı Değil."
        TextBox1 = ""
        TextBox2 = ""
        TextBox3 = ""
        TextBox6 = ""
        TextBox5 = 1
        TextBox1.SetFocus
    End If

End Sub
 
Katılım
2 Ocak 2022
Mesajlar
47
Excel Vers. ve Dili
2016 Türkçe
Kodlarını biraz düzenleyip konuyu anladığım kadarıyla yazmaya çalıştım.
Örneğin 200 değeri sayfa2 de birden fazla var, sizin kodlar ilk gördüğünü alıyordu, bende öyle bıraktım. Bu durum değişecek miydi.
TextBox1_AfterUpdate kodlarını aşağıdakilerle değiştirerek deneyiniz.

Kod:
Private Sub TextBox1_AfterUpdate()

    Dim syf(), j As Byte, i As Integer, s As Byte, c As Range, S1 As Worksheet

    syf = Array("Sayfa1", "Sayfa2")
   
    bul = TextBox1
   
    For j = 0 To UBound(syf)
        Set S1 = Sheets(syf(j))
        Set c = S1.[A:A].Find(bul, , xlValues, xlWhole)
        If Not c Is Nothing Then
       
            barkod = S1.Cells(c.Row, "A")
            urun = S1.Cells(c.Row, "B")
            urunf = S1.Cells(c.Row, "C")
            Alis = S1.Cells(c.Row, "D")
            Yuzde = S1.Cells(c.Row, "E")
            Kategori = S1.Cells(c.Row, "F")
           
            adet = TextBox5
            tutar = adet * urunf
            TextBox3.Text = FormatCurrency(tutar, 2)
            TextBox2.Text = barkod & " - " & urun
            TextBox6.Text = FormatCurrency(urunf, 2)
           
            With ListBox1
                .AddItem
                .List(.ListCount - 1, 0) = barkod
                .List(.ListCount - 1, 1) = urun
                .List(.ListCount - 1, 2) = FormatCurrency(urunf, 2)
                .List(.ListCount - 1, 3) = adet
                .List(.ListCount - 1, 4) = FormatCurrency(tutar, 2)
                .List(.ListCount - 1, 5) = Alis
                .List(.ListCount - 1, 6) = Yuzde
                .List(.ListCount - 1, 7) = Kategori
               
                For i = 0 To .ListCount - 1
                    topla4 = CDbl(.List(i, 4)) + CDbl(topla4)
                    topla5 = CDbl(Val(.List(i, 3))) + CDbl(Val(topla5))
                Next i

                TextBox4.Text = FormatCurrency(topla4, 2)

                Label14 = topla5
                .Selected(.ListCount - 1) = True
       
                TextBox1 = ""
                TextBox2 = ""
                TextBox3 = ""
                TextBox6 = ""
                TextBox5 = 1
                TextBox1.SetFocus
            End With
           
            If S1.Name = syf(0) Then
                Label15 = "AKTİF"
            Else
                Label15 = "İPTAL"
            End If
       
            s = 1
            Exit For
        End If
    Next j
   
    If s = 0 Then
        MsgBox "Ürün Kayıtlı Değil."
        TextBox1 = ""
        TextBox2 = ""
        TextBox3 = ""
        TextBox6 = ""
        TextBox5 = 1
        TextBox1.SetFocus
    End If

End Sub
Merhaba, evet bulduğu tüm kayıtları getirmesi gerekiyor. Elinize sağlık. Yardımınız için çok teşekkür ederim.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Deneyiniz.
Kod:
Private Sub TextBox1_AfterUpdate()

    Dim syf(), j As Byte, i As Integer, s As Byte, c As Range, S1 As Worksheet, Adr As String

    syf = Array("Sayfa1", "Sayfa2")
   
    bul = TextBox1
   
    For j = 0 To UBound(syf)
        Set S1 = Sheets(syf(j))
        Set c = S1.[A:A].Find(bul, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
       
                barkod = S1.cells(c.Row, "A")
                urun = S1.cells(c.Row, "B")
                urunf = S1.cells(c.Row, "C")
                Alis = S1.cells(c.Row, "D")
                Yuzde = S1.cells(c.Row, "E")
                Kategori = S1.cells(c.Row, "F")
               
                adet = TextBox5
                tutar = adet * urunf
                TextBox3.Text = FormatCurrency(tutar, 2)
                TextBox2.Text = barkod & " - " & urun
                TextBox6.Text = FormatCurrency(urunf, 2)
               
                With ListBox1
                    .AddItem
                    .List(.ListCount - 1, 0) = barkod
                    .List(.ListCount - 1, 1) = urun
                    .List(.ListCount - 1, 2) = FormatCurrency(urunf, 2)
                    .List(.ListCount - 1, 3) = adet
                    .List(.ListCount - 1, 4) = FormatCurrency(tutar, 2)
                    .List(.ListCount - 1, 5) = Alis
                    .List(.ListCount - 1, 6) = Yuzde
                    .List(.ListCount - 1, 7) = Kategori
                   
                    For i = 0 To .ListCount - 1
                        topla4 = CDbl(.List(i, 4)) + CDbl(topla4)
                        topla5 = CDbl(Val(.List(i, 3))) + CDbl(Val(topla5))
                    Next i
   
                    TextBox4.Text = FormatCurrency(topla4, 2)
   
                    Label14 = topla5
                    .Selected(.ListCount - 1) = True
           
                    TextBox1 = ""
                    TextBox2 = ""
                    TextBox3 = ""
                    TextBox6 = ""
                    TextBox5 = 1
                    TextBox1.SetFocus
                End With
           
            Set c = S1.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
           
            If S1.Name = syf(0) Then
                Label15 = "AKTİF"
            Else
                Label15 = "İPTAL"
            End If
           
            s = 1
        End If
        If s = 1 Then Exit For
    Next j
   
    If s = 0 Then
        MsgBox "Ürün Kayıtlı Değil."
        TextBox1 = ""
        TextBox2 = ""
        TextBox3 = ""
        TextBox6 = ""
        TextBox5 = 1
        Label15 = ""
        TextBox1.SetFocus
    End If

End Sub
 

Ekli dosyalar

Katılım
2 Ocak 2022
Mesajlar
47
Excel Vers. ve Dili
2016 Türkçe
Deneyiniz.
Kod:
Private Sub TextBox1_AfterUpdate()

    Dim syf(), j As Byte, i As Integer, s As Byte, c As Range, S1 As Worksheet, Adr As String

    syf = Array("Sayfa1", "Sayfa2")
   
    bul = TextBox1
   
    For j = 0 To UBound(syf)
        Set S1 = Sheets(syf(j))
        Set c = S1.[A:A].Find(bul, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
       
                barkod = S1.cells(c.Row, "A")
                urun = S1.cells(c.Row, "B")
                urunf = S1.cells(c.Row, "C")
                Alis = S1.cells(c.Row, "D")
                Yuzde = S1.cells(c.Row, "E")
                Kategori = S1.cells(c.Row, "F")
               
                adet = TextBox5
                tutar = adet * urunf
                TextBox3.Text = FormatCurrency(tutar, 2)
                TextBox2.Text = barkod & " - " & urun
                TextBox6.Text = FormatCurrency(urunf, 2)
               
                With ListBox1
                    .AddItem
                    .List(.ListCount - 1, 0) = barkod
                    .List(.ListCount - 1, 1) = urun
                    .List(.ListCount - 1, 2) = FormatCurrency(urunf, 2)
                    .List(.ListCount - 1, 3) = adet
                    .List(.ListCount - 1, 4) = FormatCurrency(tutar, 2)
                    .List(.ListCount - 1, 5) = Alis
                    .List(.ListCount - 1, 6) = Yuzde
                    .List(.ListCount - 1, 7) = Kategori
                   
                    For i = 0 To .ListCount - 1
                        topla4 = CDbl(.List(i, 4)) + CDbl(topla4)
                        topla5 = CDbl(Val(.List(i, 3))) + CDbl(Val(topla5))
                    Next i
   
                    TextBox4.Text = FormatCurrency(topla4, 2)
   
                    Label14 = topla5
                    .Selected(.ListCount - 1) = True
           
                    TextBox1 = ""
                    TextBox2 = ""
                    TextBox3 = ""
                    TextBox6 = ""
                    TextBox5 = 1
                    TextBox1.SetFocus
                End With
           
            Set c = S1.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
           
            If S1.Name = syf(0) Then
                Label15 = "AKTİF"
            Else
                Label15 = "İPTAL"
            End If
           
            s = 1
        End If
        If s = 1 Then Exit For
    Next j
   
    If s = 0 Then
        MsgBox "Ürün Kayıtlı Değil."
        TextBox1 = ""
        TextBox2 = ""
        TextBox3 = ""
        TextBox6 = ""
        TextBox5 = 1
        Label15 = ""
        TextBox1.SetFocus
    End If

End Sub
Tamamadır. Ayırdığınız zaman ve emek için çok teşekkür ederim...
 
Katılım
2 Ocak 2022
Mesajlar
47
Excel Vers. ve Dili
2016 Türkçe
Tamamadır. Ayırdığınız zaman ve emek için çok teşekkür ederim...
Merhaba, yukarıdaki kodlar ilk 10 sütun (j dahil) içerisinde sorunsuz çalışıyor. Sütün sayısını artırmak istediğimde 10. sütundan(j den) sonrası için hata veriyor. Tüm kodlar içerisindeki j leri değiştirdim. (Dim j As Byte, For j = 0 To UBound(syf) Set S1 = Sheets(syf(j)) Next j )Örnek olarak z yaptım. Başka sınırlayan satır göremedim. Ancak sonuç değişmedi. İşlem yapmak istediğim sütun sayısını nasıl artırabilirim? Teşekkür ederim.
 

bycakir

Altın Üye
Katılım
1 Aralık 2017
Mesajlar
220
Excel Vers. ve Dili
Microsoft Office 365 ProPlus
(Dim j As Byte, For j = 0 To UBound(syf) Set S1 = Sheets(syf(j)) Next j )

buradaki j hucre ile alakalı bir konu değil değiştirmeyin
 
Katılım
2 Ocak 2022
Mesajlar
47
Excel Vers. ve Dili
2016 Türkçe
(Dim j As Byte, For j = 0 To UBound(syf) Set S1 = Sheets(syf(j)) Next j )

buradaki j hucre ile alakalı bir konu değil değiştirmeyin
Anlatabilmek adına yazmıştım. İlk 10 sütundan( j stunundan) sonrasınıda nasıl dahil edebilirim. Onu yapamadım.
 

bycakir

Altın Üye
Katılım
1 Aralık 2017
Mesajlar
220
Excel Vers. ve Dili
Microsoft Office 365 ProPlus
@beza
sadece listboxda görmek içinmi? bunun içinse tahmini yazıyorum elimde veri olmadıgı için bu şekilde çoğalta bilirsiniz

barkod = S1.cells(c.Row, "A")
urun = S1.cells(c.Row, "B")
urunf = S1.cells(c.Row, "C")
Alis = S1.cells(c.Row, "D")
Yuzde = S1.cells(c.Row, "E")
Kategori = S1.cells(c.Row, "F")
istenilen başlık = S1.cells(c.Row, "G")

adet = TextBox5
tutar = adet * urunf
TextBox3.Text = FormatCurrency(tutar, 2)
TextBox2.Text = barkod & " - " & urun
TextBox6.Text = FormatCurrency(urunf, 2)

With ListBox1
.AddItem
.List(.ListCount - 1, 0) = barkod
.List(.ListCount - 1, 1) = urun
.List(.ListCount - 1, 2) = FormatCurrency(urunf, 2)
.List(.ListCount - 1, 3) = adet
.List(.ListCount - 1, 4) = FormatCurrency(tutar, 2)
.List(.ListCount - 1, 5) = Alis
.List(.ListCount - 1, 6) = Yuzde
.List(.ListCount - 1, 7) = Kategori
.List(.ListCount - 1, 8) = istenilen başlık
 
Son düzenleme:
Katılım
2 Ocak 2022
Mesajlar
47
Excel Vers. ve Dili
2016 Türkçe
sadece listboxda görmek içinmi? bunun içinse tahmini yazıyorum elimde veri olmadıgı için bu şekilde çoğalta bilirsiniz

barkod = S1.cells(c.Row, "A")
urun = S1.cells(c.Row, "B")
urunf = S1.cells(c.Row, "C")
Alis = S1.cells(c.Row, "D")
Yuzde = S1.cells(c.Row, "E")
Kategori = S1.cells(c.Row, "F")
istenilen başlık = S1.cells(c.Row, "F")

adet = TextBox5
tutar = adet * urunf
TextBox3.Text = FormatCurrency(tutar, 2)
TextBox2.Text = barkod & " - " & urun
TextBox6.Text = FormatCurrency(urunf, 2)

With ListBox1
.AddItem
.List(.ListCount - 1, 0) = barkod
.List(.ListCount - 1, 1) = urun
.List(.ListCount - 1, 2) = FormatCurrency(urunf, 2)
.List(.ListCount - 1, 3) = adet
.List(.ListCount - 1, 4) = FormatCurrency(tutar, 2)
.List(.ListCount - 1, 5) = Alis
.List(.ListCount - 1, 6) = Yuzde
.List(.ListCount - 1, 7) = Kategori
.List(.ListCount - 1, 8) = istenilen başlık
Listbox1 e gelen kayıtlardan seçilen satır textboxlara aktarılacak. J sütununa kadar olan veriler sorunsuz aktarılıyor. Sonraki sütunlar okunmuyor.

Private Sub CommandButton1_Click()
Dim syf(), j As Byte, i As Integer, s As Byte, c As Range, S1 As Worksheet, Adr As String

syf = Array("Sayfa1", "Sayfa2")

bul = TextBox1

For j = 0 To UBound(syf)
Set S1 = Sheets(syf(j))
Set c = S1.[B:B].Find(bul, , xlValues, xlWhole)
If Not c Is Nothing Then
Adr = c.Address
Do

platform = S1.Cells(c.Row, "A")
sipkod = S1.Cells(c.Row, "B")
sipdurum = S1.Cells(c.Row, "C")
siptar = S1.Cells(c.Row, "D")
sipsaat = S1.Cells(c.Row, "E")
pltkod = S1.Cells(c.Row, "F")
urunkod = S1.Cells(c.Row, "G")
varkod = S1.Cells(c.Row, "H")
urunad = S1.Cells(c.Row, "I")
secenek = S1.Cells(c.Row, "J")
' BU SÜTUNDAN SONRAKİ VERİLER OKUNMUYOR.
bfiyat = S1.Cells(c.Row, "K")
adet = S1.Cells(c.Row, "L")
ttutar = S1.Cells(c.Row, "M")
ind = S1.Cells(c.Row, "N")
ftutar = S1.Cells(c.Row, "O")



With ListBox1
.AddItem
.List(.ListCount - 1, 0) = platform
.List(.ListCount - 1, 1) = sipkod
.List(.ListCount - 1, 2) = sipdurum
.List(.ListCount - 1, 3) = siptar
.List(.ListCount - 1, 4) = sipsaat
.List(.ListCount - 1, 5) = pltkod
.List(.ListCount - 1, 6) = urunkod
.List(.ListCount - 1, 7) = varkod
.List(.ListCount - 1, 8) = urunad
.List(.ListCount - 1, 9) = secenek
.List(.ListCount - 1, 10) = bfiyat
.List(.ListCount - 1, 11) = adet
.List(.ListCount - 1, 12) = ttutar
.List(.ListCount - 1, 13) = ind
.List(.ListCount - 1, 14) = ftutar

End With

If S1.Name = syf(0) Then
TextBox16 = sipdurum

Else
TextBox16 = "İPTAL"
End If

Set c = S1.[B:B].FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
s = 1
End If
If s = 1 Then Exit For
 

bycakir

Altın Üye
Katılım
1 Aralık 2017
Mesajlar
220
Excel Vers. ve Dili
Microsoft Office 365 ProPlus
@beza dosyanızı paylasırsanız yardımcı olmaya çalısırım. texbox adresleri gerekiyor hangi stunu hangi texbota istiyorsanız belirtin
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

ListBox Additem yönteminde 10 kolon sınırı vardır. Bunu aşmak için farklı yöntemler uygulamanız gerekir. Dizi, List, Rowsource gibi. Forumda konuyla ilgili örnekler mevcuttur arama yaparak dosyanıza uyarlamaya çalışın. Dosyanıza uygulayamazsanız yeni örnek dosya ekleyiniz.
 
Üst