• DİKKAT

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

Şartlı veri çağırma

  • Konbuyu başlatan Konbuyu başlatan mtozer
  • Başlangıç tarihi Başlangıç tarihi
M

mtozer

Katılım
9 Ekim 2007
Mesajlar
216
Excel Vers. ve Dili
Office2000
sheet1 de isimlere ait veriler var. Bunlar a-b-c ve d sheet2 de b2 ye hangi isim yazılırsa sheet1 de ki o isme ait hangi degerler varsa sheet2 ye getirmesini saglayabilirmiyiz? yani aranacak başlık "isim" aranacak degerler "a-b-c ve d"

http://s6.dosya.tc/server8/c1vnsq/veri.xls.html
 
Merhaba,

Bu şekilde deneyin.

Kod: 
Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, c As Range, a As Long
    
    Set S1 = Sheets("Sheet1")
    
    Range("A5:D" & Rows.Count).ClearContents

    Set c = S1.[B:B].Find(Range("B3"), , xlValues, xlWhole)
    If Not c Is Nothing Then
        If WorksheetFunction.CountIf(S1.Range("A" & c.Row + 1 & ":A" & Rows.Count), _
            Range("A3")) = 0 Then
            a = S1.Cells(Rows.Count, "A").End(xlUp).Row - c.Row
        Else
            a = WorksheetFunction.Match(Range("A3"), _
                S1.Range("A" & c.Row + 1 & ":A" & Rows.Count), 0) - 1
        End If
        S1.Cells(c.Row + 1, "A").Resize(a, 4).Copy Range("A5")
    End If

End Sub

.
 
tesekkur ederim hocam çalıştı. Ama ben kodu çözemedim. Asıl amacım aranan değer a-b-c-d değilde Alüminyum-Krom-Siyah Sac-Bakır olsaydı kodu nasıl düzenlememiz gerekir. (Orjinal liste karmaşık olduğundan onu paylaşmadım.Kafa karıştırmasın diye.)
 
Birde "F" sütununa kadar olan değerleri getirmesini sağlayabilirmiyiz.
 
Kod B3 deki değeri Sheet1 de arıyor, bulduğu satırın altındaki A ile D sütunu arasındaki verileri Sheet2 sayfasına kopyalıyor.

Örneğin, "hasan" değerini B19 da buluyor, A20: D22 arasını kopyalayıp diğer sayfada A5 den başlayarak yapıştırıyor.

O isme ait tüm verileri aldığım için, a-b-c-d diye bir şart koymadım. Sadece isimden aratıp o isme ait tüm değerleri getirdim.

F sütununa kadar dahil olsun isterseniz aşağıdaki 4 yerine 6 yazın.

S1.Cells(c.Row + 1, "A").Resize(a, 4).Copy Range("A5")

.
 
Merhaba.

Konu Makro-VBA bölümünde açılmış ama;
formül ile çözüm önerisi isterseniz aşağıdaki formülün işinizi görmesi lazım.
Aynı ismin tekrarlanmadığı ve verilerin 1000'inci satıra kadarki alanda olduğu varsayılmıştır.

=> Formülü A5 hücresine uygulayıp, sonra sağa ve aşağı kopyalayın.
.
Kod: 
=[COLOR="red"]EĞERHATA[/COLOR]([COLOR="red"]EĞER[/COLOR]([COLOR="red"]SATIR[/COLOR](A1)>[COLOR="red"]EĞERHATA[/COLOR]([COLOR="Red"]KAÇINCI[/COLOR]($A$3;DOLAYLI("[COLOR="DarkOrange"]Sheet1![/COLOR]A"&[COLOR="Red"]KAÇINCI[/COLOR]($B$3;[COLOR="DarkOrange"]Sheet1![/COLOR]$B$1:$B$[B][COLOR="Blue"]1000[/COLOR][/B];0)+1&":A[B][COLOR="Blue"]1000[/COLOR][/B]");0)-1;([COLOR="Red"]KAÇINCI[/COLOR]("ZZZ";[COLOR="DarkOrange"]Sheet1![/COLOR]$A$1:$A$[B][COLOR="Blue"]1000[/COLOR][/B];1))-([COLOR="Red"]KAÇINCI[/COLOR]($B$3;[COLOR="DarkOrange"]Sheet1![/COLOR]$B$1:$B$[B][COLOR="Blue"]1000[/COLOR][/B];0)+1)+1);"";[COLOR="Red"]KAYDIR[/COLOR]([COLOR="DarkOrange"]Sheet1![/COLOR]$A$1;[COLOR="Red"]KAÇINCI[/COLOR]($B$3;[COLOR="DarkOrange"]Sheet1![/COLOR]$B$1:$B$[B][COLOR="Blue"]1000[/COLOR][/B];0)+1+[COLOR="red"]SATIR[/COLOR](A1)-2;[COLOR="Red"]SÜTUN[/COLOR](A1)-1));"")
 
Bu şekilde deneyin.

Fiş sayfası A2 deki değer ile sa1 sayfasındaki A2 deki değer eşit olmadığı için hatalı sonuçlar gelmiş. 2. aramayı sa1 A2 göre yaptım.

Kod: 
Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, c As Range, a As Long
    
    Set S1 = Sheets("[COLOR="red"]sa1[/COLOR]")
    
    Range("[COLOR="Red"]A5:F[/COLOR]" & Rows.Count).Clear

    Set c = S1.[[COLOR="red"]B:B[/COLOR]].Find(Range("[COLOR="red"]B2[/COLOR]"), , xlValues, xlWhole)
    If Not c Is Nothing Then
        If WorksheetFunction.CountIf(S1.Range("A" & c.Row + 1 & ":A" & Rows.Count), _
            [COLOR="red"]S1.Range("A2")[/COLOR]) = 0 Then
            a = S1.Cells(Rows.Count, "A").End(xlUp).Row - c.Row
        Else
            a = WorksheetFunction.Match([COLOR="red"]S1.Range("A2")[/COLOR], _
                S1.Range("A" & c.Row + 1 & ":A" & Rows.Count), 0) - 1
        End If
        S1.Cells(c.Row + 1, "A").Resize(a, [COLOR="red"]6[/COLOR]).Copy Range("A5")
    End If

End Sub

.
 
Teşekkür ederim hocam. Tamamdır elinize sağlık. Birde birşey daha var; Bir Combobox "B2" hücresine koymak istiyorum "sa1" deki B sütununu gösterecek ancak aradaki boşlukları ve "işçilik tutarı" sözcücüğünü görmesin istiyorum. Bunu nasıl yapabiliriz.
 
Sayfa üzerinde combobox nesnesine veri alırken sorun yaşayabilirsiniz. Bunun için userform kullanmanızı tavsiye ederim.

Aşağıdaki işlemleri uygulayın.

Yukarıda verdiğim kodları fiş sayfasından silin.

Dosyanıza yeni bir form ekleyip bu forma sadece bir combobox ilave edin.

Yeni eklediğiniz userforma aşağıdaki kodları yapıştırın.

Kod: 
Private Sub [COLOR="Red"]ComboBox1[/COLOR]_Change()

    Dim S1 As Worksheet, c As Range, a As Long
    
    Set S1 = Sheets("sa1")
    
    Range("A5:F" & Rows.Count).Clear
    Range("B2") = [COLOR="Red"]ComboBox1[/COLOR].Value

    Set c = S1.[B:B].Find(Range("B2"), , xlValues, xlWhole)
    If Not c Is Nothing Then
        If WorksheetFunction.CountIf(S1.Range("A" & c.Row + 1 & ":A" & Rows.Count), _
            S1.Range("A2")) = 0 Then
            a = S1.Cells(Rows.Count, "A").End(xlUp).Row - c.Row
        Else
            a = WorksheetFunction.Match(S1.Range("A2"), _
                S1.Range("A" & c.Row + 1 & ":A" & Rows.Count), 0) - 1
        End If
        S1.Cells(c.Row + 1, "A").Resize(a, 6).Copy Range("A5")
    End If
    
    Unload Me
    
End Sub

Private Sub UserForm_Initialize()

  Dim S1 As Worksheet, i As Long
    
    Set S1 = Sheets("sa1")
    
    [COLOR="red"]ComboBox1[/COLOR].Clear
    For i = 2 To S1.Cells(Rows.Count, "B").End(xlUp).Row
        If S1.Cells(i, "B") <> "" Then
            If S1.Cells(i, "B") <> "İşçilik Tutarı" Then
                If IsNumeric(S1.Cells(i, "B")) = False Then
                    [COLOR="red"]ComboBox1[/COLOR].AddItem S1.Cells(i, "B")
                End If
            End If
        End If
    Next i
    
End Sub


Daha sonra fiş sayfasının kod bölümüne aşağıdaki kodları ekleyin.

Kod: 
Private Sub CommandButton1_Click()
    UserForm2.Show 0
End Sub

Artık sayfadaki butona tıkladığınızda önce bir form açılır, buradan seçtiğiniz isim listelenir ve form kapanır.

--------------------------------------------------------------------------------------------------------------------------------------------

Eğer sayfada combobox ile çözmek isterseniz. Sayfaya bir combobox ekleyin ve eski kodları silip aşağıdaki kodları sayfanın kod bölümüne kopyalayın.

Artık combobox dan seçim yaptığınızda veriler gelir.

Yalnız comboboxa sayfa aktif olduğunda veriler alınır. Bu yüzden bir seferlik sa1 sayfasına gidip tekrar fiş sayfasına dönün.

Kod: 
Private Sub ComboBox1_Change()

    Dim S1 As Worksheet, c As Range, a As Long
    
    Set S1 = Sheets("sa1")
    
    Range("A5:F" & Rows.Count).Clear

    If ComboBox1.Value = "" Then Exit Sub

    Set c = S1.[B:B].Find(ComboBox1.Value, , xlValues, xlWhole)
    If Not c Is Nothing Then
        If WorksheetFunction.CountIf(S1.Range("A" & c.Row + 1 & ":A" & Rows.Count), _
            S1.Range("A2")) = 0 Then
            a = S1.Cells(Rows.Count, "A").End(xlUp).Row - c.Row
        Else
            a = WorksheetFunction.Match(S1.Range("A2"), _
                S1.Range("A" & c.Row + 1 & ":A" & Rows.Count), 0) - 1
        End If
        S1.Cells(c.Row + 1, "A").Resize(a, 6).Copy Range("A5")
    End If
    
End Sub

Private Sub Worksheet_Activate()

  Dim S1 As Worksheet, i As Long
    
    Set S1 = Sheets("sa1")
    
    ComboBox1.Clear
    For i = 2 To S1.Cells(Rows.Count, "B").End(xlUp).Row
        If S1.Cells(i, "B") <> "" Then
            If S1.Cells(i, "B") <> "İşçilik Tutarı" Then
                If IsNumeric(S1.Cells(i, "B")) = False Then
                    ComboBox1.AddItem S1.Cells(i, "B")
                End If
            End If
        End If
    Next i
    
End Sub


.
 
tamamdır hocam elinize sağlık. UserForm ile sorunsuz oldu.
 
Son olarak G ve N sütunları arasını da alt alta listeleyebilirmiyiz. malzemelerden sonra 3-4 satır boşluk bırakarak. Yani görüntü şu şekilde olmalı.

Malzemeler


Toplam:
KDV dahil Mlz.:
KDV dahil işçilik:
KDV dahil toplam:
 
Olması gereken görüntüyü örnek dosya üzerinde göstermenizi rica ederim.

.
 
birde bir sorun daha var hocam. hücre çizgilerini yaptıgımda veri çağırınca çizgileri bozuyor. incelermisiniz.
 
Tablo anlaşılır değil.

Örneğin dene2 değerine göre sarı alan ne olması gerekiyor ve neden?

Bu şekilde bir örnek üzerinde dosya ekleyerek açıklamanızı rica etmiştim.
 
sarı alanda bir değişiklik yapmayacağız. Sadece
Toplam:
KDV dahil Mlz.:
KDV dahil işçilik:
KDV dahil toplam:

bu değerleri C sütununa veya d sutununa getireceğiz.
 
Daha önce G:N arası listelenecek demiştiniz. Şimdi sarı alan diyorsunuz. Tam olarak yapmak istediğinizi anlayamadım maalesef. Konuyu biliyormuşum gibi değil bilmiyormuşum gibi açıklama yaparsanız sevinirim. Bu şekilde sonuçlara daha hızlı ulaşırız.

Hangi bölgeyi hangi alana getirmek istiyorsanız örnek dosya üzerinde manuel yapın(veri içleri dolu olsun lütfen). Bu şekilde dosya ekleyiniz. Yada hücre hücre, örneğin sayfa1 A5 deki veri sayfa2 C4 e şu nedenden dolayı gelsin türünde açıklama yapmanızı rica ederim.

.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst