Farklı 2 sayfadaki kayıtları bulma,

beza · 11 Ocak 2022

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 · 11 Ocak 2022

Merhaba,

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

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

beza · 11 Ocak 2022

Ö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.

İndir Makro Siparis

Dosyayı indir Makro Siparis

dosya.co

Ömer · 11 Ocak 2022

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.

beza · 11 Ocak 2022

Ömer' Alıntı:
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 · 11 Ocak 2022

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

beza · 12 Ocak 2022

Ömer' Alıntı:

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 · 12 Ocak 2022

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

beza · 12 Ocak 2022

Ömer' Alıntı:

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...

beza · 14 Ocak 2022

beza' Alıntı:
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 · 14 Ocak 2022

(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

beza · 14 Ocak 2022

bycakir' Alıntı:
(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 · 14 Ocak 2022

@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

beza · 14 Ocak 2022

bycakir' Alıntı:
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 · 14 Ocak 2022

@beza dosyanızı paylasırsanız yardımcı olmaya çalısırım. texbox adresleri gerekiyor hangi stunu hangi texbota istiyorsanız belirtin

Ömer · 15 Ocak 2022

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.

Farklı 2 sayfadaki kayıtları bulma,

beza

Ömer

Moderatör

Dosya Yükle - Dosya Upload

beza

İndir Makro Siparis

Ömer

Moderatör

beza

Ömer

Moderatör

beza

Ömer

Moderatör

Ekli dosyalar

beza

beza

bycakir

beza

bycakir

beza

bycakir

Ömer

Moderatör