Datadan Sonuç sayfasına Veri almak

[tamer42]

Tamer hocam ekli dosyayı da kontrol ettim aynı sorun devam ediyor.Ancak Ziynettin hocam konuyu halletti. Sizinde yardımlarınız için teşekkür ederim

Data sayfasında; 5 Yıllık Yedek Parça sütununda "RBS 46" bulunmuyordu, o nedenle sonuçları geriremiyordu.

"RBS 55" kalemini "RBS 46" olarak getirince sonuçlar geldi, ekli resimleri kontrol ediniz

Ayrıca Data sayfasında Yıllık parça sütununda "RBS 35" den sonra gelenlerde "YEDEK PARÇA" ifadesi yazılmamış durumda;

Bunun dışında başka sorunun ne olduğunu anlayamadım, ekran görüntüsü gönderir misiniz;

 

[silver_storm]

Ziynettin hocam ellerine sağlık tam ihtiyacım gibi oldu. Çok çok teşekkür ederim.
Ancak son bir sorum olacak.
Command Butona bastıktan sonra gelen mesaj kutusunun çıkmaması için ne yapmamız gerekli ?

Ziynettin Hocam merhabalar ;

Dediğiniz gibi koda ekleme yaptıktan sonra aşağıdaki resimlerdeki gibi sorun çıkmaya başladı.

Şöyle ki RBS 15 in herhangi bir sekmesini seçtiğimde aşağıdaki gibi yazılar çıkıyor.

Bu konuda bana yardımcı olursanız çok sevinirim.

 

[Ziynettin]

adres = s1.Columns(sutun).Find(model & " " & islem, , , , xlByRows, xlNext).Address

yerine;

adres = s1.Columns(sutun).Find(model & " " & Split(islem, " ")(0), , , , xlByRows, xlNext).Address

satırını kullanın.


Not: Data sayfası D sütunu boş olmalı.

#16. iletideki Not açıklmasını uygulayın.

 

[silver_storm]

hocam her ikinizin de ellerine sağlık

 

[silver_storm]

Saygıdeğer hocalarım merhabalar ;

Yapmış olduğumuz excelde DATA sayfasına 2 yeni kolon ekleyerek stok kodlarını da ekledim ancak bir türlü sonuç sayfasına getiremiyorum.

Bana yardımcı olursanız çok sevinirim.

Teşekkür ederim.

 

[Ziynettin]

J-P sütunları gizli kaldırınız.

Kod yeniden düzenlendi.

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet
Dim model As String, islem As String
Dim i As Long
Set s1 = Sheets("Data")
Set s2 = Sheets("Sonuç")
model = s2.[A3]
islem = s2.[C3]
krt = UCase(Replace(Replace(model & " " & islem, "i", "İ"), "ı", "I"))
s2.[G6] = krt
On Error Resume Next
Err = 0
sutun = WorksheetFunction.Match(islem, s1.Rows(1), 0)
    If Err = 0 Then
        adres = s1.Columns(sutun).Find(model & " " & Split(islem, " ")(0), , , , xlByRows, xlNext).Address(, 0)
        w = Split(adres, "$")(1)
        If w = 2 Then: w = 3: Else: w = 2
        a = s1.Range(adres).CurrentRegion.Value
        ReDim b(1 To UBound(a) - 1, 1 To UBound(a, 2) + 1)
        For i = w To UBound(a)
            say = say + 1
            b(say, 1) = say
            For j = 1 To UBound(a, 2)
                b(say, j + 1) = a(i, j)
            Next j
        Next i
        s2.Range("F9:L" & Rows.Count) = ""
        s2.Range("F9:L" & Rows.Count).Borders.LineStyle = xlNone
        If say > 0 Then
            s2.[F9].Resize(say, UBound(a, 2) + 1).Borders.LineStyle = 1
            s2.[F9].Resize(say, UBound(a, 2) + 1) = b
        End If
        MsgBox "İşlem tamam.", vbInformation
    Else
        MsgBox krt & "  ait bilgi bulunamadı.", vbCritical
    End If
On Error GoTo 0
End Sub