- 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
[/url][/IMG]
[](http://hizliresim.com/OBA32Z)
Ç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
[](http://hizliresim.com/OBA32Z)
