• DİKKAT

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

Sql den gelen verinin en yakın yere bir satır eklenerek yazdırılması

Katılım
14 Ocak 2005
Mesajlar
807
Excel Vers. ve Dili
Microsoft Office Professional Plus 2021
Merhaba arkadaşlar sizlerden aldığım bilgiler ışığında aşağıdaki gibi bir çalışmam var tabi sql sorguları yukarıda şimdilik sadece ilgili yeri burada.
Çalışmamı kısaca aşağıda anlattım yardımlarınız bekliyorum.
En altta da çalışmamın resmini koyuyorum daha iyi anlaşılsın diye.
Saygılarımla.

Dim SQLText, sayfaadi, deger, sonsira As String

sayfaadi = CStr(ActiveSheet.Name)


Set Z = CreateObject("Scripting.dictionary")
For a = 7 To Sheets(sayfaadi).Cells(65536, "C").End(xlUp).Row
If Not Z.exists(Sheets(sayfaadi).Cells(a, "C").Value) Then
Z.Add CStr(Sheets(sayfaadi).Cells(a, "C").Value), a
End If
Next a



For i = 8 To 4000
If Cells(i, "B") = 0 And (Cells(i, "C") Like "6*" Or Cells(i, "C") Like "7*") Then
Cells(i, "N").Resize(1, 2).ClearContents
End If

Next i



Dim RST As New ADODB.Recordset

Call Main
DoEvents
SQLCON.Open


SQLText = "SELECT ADSDOS_MLZ_KOD, ADSDOS_ACK, SUM(ADSDOS_STK_MIK), SUM(ADSDOS_NET_TLL) " & vbCrLf
'SQLText = SQLText & " GECENV_CIK_MIK,GECENV_IML_MIK,GECENV_EKS_MIK,GECENV_HAS_MIK,GECENV_IAD_MIK,GECENV_SAT_MIK " & vbCrLf
SQLText = SQLText & " FROM ADSDOS " & vbCrLf
'SQLText = SQLText & " LEFT OUTER JOIN STKMLZ ON STKMLZ_KOD = GECENV_MLZ " & vbCrLf

SQLText = SQLText & " WHERE ADSDOS_DEP = '" + DEPARTMAN + "' AND ADSDOS_TAR BETWEEN '" + BASTAR + "' AND '" + BITTAR + "' " & vbCrLf
SQLText = SQLText & " GROUP BY ADSDOS_MLZ_KOD, ADSDOS_ACK " & vbCrLf
SQLText = SQLText & " ORDER BY ADSDOS_MLZ_KOD " & vbCrLf



Set RST.DataSource = SQLCON.Execute(SQLText)



'Range("L8:L65000").Select
'Selection.ClearContents

sonsira = 4601

Do Until RST.EOF

For i = 1 To RST.RecordCount Step 1

deger = CStr(RST.Fields(0).Value)

'değer değişkenindeki boşluğu siliyor.
deger = Replace((deger), " ", "")

If Z.exists(deger) Then
Sheets(sayfaadi).Cells(Z.Item(deger), 15) = RST.Fields(2) ' SATIŞ MİKTARINI AKTARDI
Sheets(sayfaadi).Cells(Z.Item(deger), 16) = RST.Fields(3) ' SATIŞ TUTARI AKTARDI

If Sheets(sayfaadi).Cells(Z.Item(deger), 16).Value > 0 Or Sheets(sayfaadi).Cells(Z.Item(deger), 15).Value > 0 Then
Sheets(sayfaadi).Cells(Z.Item(deger), 14) = Sheets(sayfaadi).Cells(Z.Item(deger), 16).Value / Sheets(sayfaadi).Cells(Z.Item(deger), 15).Value
End If

Else
' BURASI yıl içinde kodu olmayan ürünleri en alta sonsira değerinin olduğu satıra yazdırır her yıl için ayrıdır.

Yapmak istediğim burada deger değişkeni ile eşleşmeyen verilerin deger değişkenindeki veri ile en yakın yere
mesela resimin sağında görüldüğü gibi deger değişkenimiz 610504001085 olsun en yakın bir düşüğü olan 610504001080
değerinin bir altına bir satır ilave edip rengini kırmızı yaparak oraya yazdırmak istiyorum. Bunun için nasıl bir kod
yazmalıyım buraya. Saygılarımla.

Git bul deger değişkeninde en yakın bir düşük değeri
ve onun bir altına bir satır ilave et
bu değerleri o satıra yaz.
Sanınırım bu şekilde diyeceğiz kodlaması nasıl olmalı.

Sheets(sayfaadi).Cells((sonsira), 3) = RST.Fields(0) ' SATIŞ KODU
Sheets(sayfaadi).Cells((sonsira), 4) = RST.Fields(1) ' SATIŞ ADI
Sheets(sayfaadi).Cells((sonsira), 15) = RST.Fields(2) ' SATIŞ MİKTARINI AKTARDI
Sheets(sayfaadi).Cells((sonsira), 16) = RST.Fields(3) ' SATIŞ TUTARI AKTARDI
sonsira = sonsira + 1

End If

OBA32Z.jpg
[/url][/IMG]
OBA32Z

[![image](http://i.hizliresim.com/OBA32Z.jpg)](http://hizliresim.com/OBA32Z)
 
Geri
Üst