• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Farklı 2 sayfadaki kayıtları bulma,

  • Konbuyu başlatan Konbuyu başlatan beza
  • Başlangıç tarihi Başlangıç tarihi
beza

beza

Katılım
2 Ocak 2022
Mesajlar
83
Excel Vers. ve Dili
2007Tü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.
 
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
 
Ö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
 
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.
Genişletmek için tıkla ...
 
Ö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?
Genişletmek için tıkla ...
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.
 
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
 
Ö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
Genişletmek için tıkla ...
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.
 
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

Ö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
Genişletmek için tıkla ...
Tamamadır. Ayırdığınız zaman ve emek için çok teşekkür ederim...
 
beza' Alıntı:
Tamamadır. Ayırdığınız zaman ve emek için çok teşekkür ederim...
Genişletmek için tıkla ...
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.
 
(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
 
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
Genişletmek için tıkla ...
Anlatabilmek adına yazmıştım. İlk 10 sütundan( j stunundan) sonrasınıda nasıl dahil edebilirim. Onu yapamadım.
 
@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:
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
Genişletmek için tıkla ...

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
 
@beza dosyanızı paylasırsanız yardımcı olmaya çalısırım. texbox adresleri gerekiyor hangi stunu hangi texbota istiyorsanız belirtin
 
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.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst