Ado ile veri çekme Hk.

[valentino06]

Değerli Excel Hocalarım lütfen yardımcı olabilir misiniz.. 2 tane sorun ile karşılaştım. lütfen yardımcı olabilir misiniz. "Ana İhtiyaç belirleme sayfasında "A " sütununa getirmiş olduğum Sipariş kodlarını altında sipariş kodu olmadığı halde veri getiriyor. örnek lütfen 5444 satırdan sonra göreceksiniz.Eğer A sutununda kod varsa sadece bu kodlara ait veriler gelsin.
2. ise Kalite standartı başka standart olduğu halde hepsini "EN" Getiriyor. Hocam lütfen yardımcı olabilirmisiniz. vba içinde modül adı "Ürün_İht_Listesi" Yardımlarınızdan dolayı çok teşekkür ederim.

 

[Erdem Akdemir]

Merhaba,

Aşağıdaki kodu kullanabilirsiniz.

Sub Ürün_İhtiyaç_Tablosu()

Range("A2:H" & Rows.Count).Clear

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select Sipariş,[İhtiyaç miktarı (EINHEIT)],[Malzeme kısa metni],'' As Kalitesi," & _
        " '' AS [Kalite Standartı],Tanıtıcı,[Poz Toplam Brüt Ağırlık],'' as [Ana İhtiyaç] from[İşlemler$]" & _
        " where sipariş is not null "

Set rs = con.Execute(sorgu)
Range("A2").CopyFromRecordset rs

son = Cells(Rows.Count, 1).End(3).Row

For i = 2 To son

deg = Split(Cells(i, "c"), "-")

Cells(i, "c") = deg(0)
Cells(i, "d") = deg(1)

Select Case VBA.Left(deg(1), 1)
Case "C"
Cells(i, "e") = "CSA"
Case "A"
Cells(i, "e") = "ASTM"
Case Else
Cells(i, "e") = "EN"
End Select

Cells(i, "h") = Cells(i, "b") - Cells(i, "g")

Next i

Cells.EntireColumn.AutoFit

End Sub

 

[valentino06]

Sayın@Erdem Hocam çok teşekkür ederim. Allah razı olsun.
İyi günler dilerim.
Saygılarımla,

 

[valentino06]

Değerli Excel Hocalarım bana yardımcı olabilirmisiniz. Hocam "ana ihtiyaç belirleme" sayfasında "G"Sutununda toplamlar "B"Sutunundan Büyük ise 0 yazsın Hocam eğer Küçük ise "B"Sutunundaki İhtiyaç Toplamlarını yazsın. Hocalarım "0" olanların rengi kırmızı olsun. "0" dan büyük olan değerler ise yeşil olsun. istiyorum. eğer yapılabilirse zemin renkleri de farklı olsun. Hocalarım yardımlarınızdan dolayı çok teşekkür ederim. Not: vba sayfasındaki modül adı:" Ürün_İht_Listesi"

 

[valentino06]

Değerli Hocalarım bu işlem "H2 : H" Sutununda olacak lütfen yardımcı olabilirmisiniz. bilgiyi eksik yazmışım özür dilerim. Hayırlı Akşamlar Dilerim.
Saygılarımla,

 

[valentino06]

Değerli Hocalarım lütfen yardımcı olabilirmisiniz. çok teşekkür ederim.
Saygılarımla,
İyi günler dilerim.

 

[Korhan Ayhan]

Deneyiniz.

Sub Ürün_İhtiyaç_Tablosu()
    Application.ScreenUpdating = False
    
    Range("A2:H" & Rows.Count).Clear
    
    Set con = VBA.CreateObject("adodb.Connection")
    
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
    
    sorgu = "select Sipariş,[İhtiyaç miktarı (EINHEIT)],[Malzeme kısa metni],'' As Kalitesi," & _
            " '' AS [Kalite Standartı],Tanıtıcı,[Toplam Ağırlık],'' as [Ana İhtiyaç] from[İşlemler$]" & _
            " where sipariş is not null "
    
    Set rs = con.Execute(sorgu)
    Range("A2").CopyFromRecordset rs
    
    son = Cells(Rows.Count, 1).End(3).Row
    
    For i = 2 To son
        deg = Split(Cells(i, "c"), "-")
        
        Cells(i, "c") = deg(0)
        Cells(i, "d") = deg(1)
        
        Select Case VBA.Left(deg(1), 1)
            Case "C"
                Cells(i, "e") = "CSA"
            Case "A"
                Cells(i, "e") = "ASTM"
            Case Else
                Cells(i, "e") = "EN"
        End Select
        
        If Cells(i, "g") > Cells(i, "b") Then
            Cells(i, "h") = 0
            Cells(i, "h").Interior.Color = 255
        ElseIf Cells(i, "g") < Cells(i, "b") Then
            Cells(i, "h") = Cells(i, "b")
            If Cells(i, "h") > 0 Then Cells(i, "h").Interior.Color = 5296274
        Else
            Cells(i, "h") = Cells(i, "g") - Cells(i, "b")
            If Cells(i, "h") > 0 Then Cells(i, "h").Interior.Color = 5296274
        End If
    Next i
    
    Cells.EntireColumn.AutoFit

    Application.ScreenUpdating = True
    
    MsgBox "İhtiyaç listesi hazırlanmıştır.", vbInformation
End Sub

 

[valentino06]

Sayın Korhan Ayhan Hocam aşağıdaki hatayı verdi. Yardımlarınızdan dolayı çok teşekkür ederim.
Saygılaımla,
İyi günler dileri.

 

[YUSUF44]

O satırdan önceki End Sub satırını silip dener misiniz?

 

[valentino06]

Korhan Hocam çok teşekkür ederim. düzeldi End sub iki taneymiş silince düzeldi.

 

[valentino06]

Sayın Korhan Ayhan Hocam diğer Excel Hocalarıma sonsuz teşekkürlerimi sunarım.Allah Kat Kat Razı olsun. Sağolun,varolun.
Saygılarımla,
İyi günler Dilerim.

 

[Korhan Ayhan]

Bu tarz hatalarla karşılaşmamak için ilk önce modül içindeki eski kodları CTRL+A ile komple seçip silin. (Eğer başka kodlar yoksa bu işlemi yapınız)

Sonrasında önerilen kodu uygulayıp deneyiniz.

Ya da boş bir modül ekleyip önerilen kodları buraya uygulayıp deneyiniz. Sonrasında eski problemli modülü silersiniz.