Kayıt tarama_ yedek parça listesi

[eklerpasta]

Merhabalar,

elimde çeşitli malzeme kayıtlarının bulunduğu bir excel dosyası var, summary sheetının en alt satırına bır kod yazıldıgında, bu malzeme kodunun agustos-eylül-ekim ayları sheetlerınde olup olmadığını kontrol ediyor, eğer oncekı aylarda gırıs yapılmıssa onları alt altta getırıyor, yoksa onceden kayıt yapılmamıstır seklınde bır uyarı verıyor. Ancak bu sorguyu summary sheetı ıcın yapmıyor.


End if sheetının basına ve sonuna ' ve ' koydugumda donguyu summary sheetınde de yapıyor. Ancak o zamanda yenı gırıs yapılan satırıda göz onunde bulunduruyor ve onu da getırıyor. Ama mantıklı olarak sorgu yaptıgımız satırı getırmemesı daha kullanıslı hale getırecektır dosyayı.

Aynı zamanda bir malzeme kodu dosyada hıc bulunmuyorsada kayıt hic girilmemistir uyarısıda getirmeli.

Konuyla ılgılı yardımcı olabılırseniz çok sevinirim. Şimdiden vakit ayırdığınız için teşekkür ederim.

 

[Ömer]

Merhaba,

Soru başlığınızı konunun içeriğini özetleyecek şekilde değiştirmenizi rica ederim.

Açılan Konu Başlığını Düzeltmek

Forum Kurallarına Uymayan Başlıklar

.

 

[hamitcan]

Böyle deneyin.

Sub kontrol(parca As Double, sat As Long)
'Sub kontrol()
Dim sh As Worksheet
Dim s1 As Worksheet
Dim rs As New ADODB.Recordset
Set s1 = ThisWorkbook.Sheets("summary")
s = sat + 1
Set conn = econn
conn.CursorLocation = adUseClient
Dim dizi As Variant
    t_say = 0
    For i = 1 To Sheets.Count
'          If Sheets(i).Name = "summary" Then
'          GoTo gec1
'          End If
            
            son1 = Sheets(i).[B65536].End(3).Row
            
            sqlStr = "select * from [" & Sheets(i).Name & "$a1:h" & son1 & "]where [Parça Kodu]=" & parca
            rs.Open sqlStr, conn, 1, 1
            If rs.EOF = True Then GoTo gec
            Do While Not rs.EOF
                   t_say = t_say + 1
'                   s1.Cells(s, "a") = s1.Cells(s - 1, "a") + 1
                   Application.EnableEvents = False
                   s1.Cells(s, "b") = rs("Parça Kodu")
                   Application.EnableEvents = True
                   s1.Cells(s, "c") = rs("Talep Eden")
                   s1.Cells(s, "d") = Format(rs("Talep tarihi"), "dd/mm/yyyy")
                   s1.Cells(s, "e") = Format(rs("Fiyat Tarihi"), "dd/mm/yyyy") & ""
                   s1.Cells(s, "f") = rs("Durumu")
                   s1.Cells(s, "g") = rs("Not")
                   s1.Cells(s, "h") = rs("Hata")
                   s1.Cells(s, "I") = Sheets(i).Name
                   s = s + 1
               rs.MoveNext
             Loop
gec:
rs.Close: Set rs = Nothing
'gec1:
    Next i
conn.Close
son:
Set conn = Nothing
sqlStr = vbNullString
Set sh = Nothing
If t_say = 0 Then MsgBox "Daha önce kayıt girilmemiştir."
End Sub

 

[eklerpasta]

Merhaba Hamitcan Bey,

çok teşekkür ederim.

Agustos-eylul-ekım-summary sheetlerinde bulunan aynı kodu sorguya yazdıgımızda sadece agustos ayındakı verıyı getırıyor. Diğer sheetlerde bulunan ilgili verileri de getirttirebilir miyiz?

 

[hamitcan]

Yukarıdaki kodu düzenleyemedim bu yüzden farklı bir çözüm ürettim.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 2 Then Exit Sub
    If Target = Empty Then Exit Sub
    t = Target.Row
    For i = 1 To 3
    For j = 2 To Sheets(i).[b65536].End(3).Row
        If Sheets(i).Name = "summary" Then Exit Sub
        With Sheets(i)
        If Target.Value = .Cells(j, 2) Then
            c = c + 1
            Application.EnableEvents = False
            Cells(t, 1) = t - 1
            Cells(t, 2) = Target.Value
            Cells(t, 3) = Sheets(i).Cells(j, 3)
            Cells(t, 4) = Sheets(i).Cells(j, 4)
            Cells(t, 5) = Sheets(i).Cells(j, 5)
            Cells(t, 6) = Sheets(i).Cells(j, 6)
            Cells(t, 7) = Sheets(i).Cells(j, 7)
            Cells(t, 8) = Sheets(i).Cells(j, 8)
            Application.EnableEvents = True
        End If
    End With
    Next
    t = t + 1
    Next
End Sub