Sayfayı set e alıp rst ile kontrol dan sonra yoksa satır ekletip bilgi yazdırmak

[a_self_lion]

Selam arkadaşlarım.
Aşağıda kodlarımla Ben hazır olan excel sayfamda ki verilerimi Sql deki TABLOM adlı bir tablodan a sütunundaki kodlarımla karşılaştırıyorum ve aynı olanların hemen yanlardaki sütunlarımın değerlerini güncelliyorum.
Fakat yeni bir ilave yapılması gerekiyor ama mantığını yapamadım. Yardım olursanız sevinirim.
Eğer değerler aynı ise zaten güncelliyordu fakat yeni elde ettiğim sql deki kodum sete aldığım eski excel sayfamdaki verilerimin içinde yoksa o veriye yukardan küçükten büyüğe göre denk gelecek yere excel sayfamda bir satır ekleyerek onun bilgilerini nasıl yazdırabilirim.
İnş. Anlatabilmişimdir.

Private Sub CommandButton1_Click()
'verileri koda göre güncelle.
Dim sayfaadi As String
sayfaadi = Cells(5, 2).Value
Set z = CreateObject("Scripting.dictionary")
For a = 8 To Sheets(sayfaadi).Cells(65536, "A").End(xlUp).Row
    If Not z.exists(Sheets(sayfaadi).Cells(a, "A").Value) Then
        z.Add CStr(Sheets(sayfaadi).Cells(a, "A").Value), a
    End If
Next a
Dim BASTAR As String   Dim BITTAR As String  Dim BSYIL As String  Dim BSAY As String
Dim BSGUN As String  Dim BTYIL As String  Dim BTAY As String  Dim BTGUN As String
Dim DEPARTMAN As String  Dim SQLText As String  Dim i As Integer  
Dim RST As New ADODB.Recordset
Call Main
DoEvents
SQLCON.Open
BSYIL = Range("B3")
BSAY = Range("C3")
BSGUN = Range("D3")
BTYIL = Range("B4")
BTAY = Range("C4")
BTGUN = Range("D4")
BASTAR = BSYIL + " - " + BSAY + " - " + BSGUN
BITTAR = BTYIL + " - " + BTAY + " - " + BTGUN
DEPARTMAN = Range("C1")
SQLText = "SELECT TABLOM_MLZ,STKMLZ_ADI1,TABLOM_DEV_MIK,TABLOM_IRS_MIK,TABLOM_TES_MIK,TABLOM_GIR_MIK,TABLOM_URT_MIK,TABLOM_ART_MIK,TABLOM_RZG_MIK, " & vbCrLf
SQLText = SQLText & " TABLOM_CIK_MIK,TABLOM_IML_MIK,TABLOM_EKS_MIK,TABLOM_HAS_MIK,TABLOM_IAD_MIK,TABLOM_SAT_MIK " & vbCrLf
SQLText = SQLText & " FROM TABLOM " & vbCrLf
SQLText = SQLText & " LEFT OUTER JOIN STKMLZ ON STKMLZ_KOD = TABLOM_MLZ " & vbCrLf
SQLText = SQLText & " WHERE TABLOM_CPFACD = '" + DEPARTMAN + "' AND " & vbCrLf
SQLText = SQLText & " TABLOM_TAR = '" + BASTAR + "' " & vbCrLf
Set RST.DataSource = SQLCON.Execute(SQLText)
'Range("A8:O65000").Select
'Selection.ClearContents
Dim deger As String
Do Until RST.EOF
For i = 1 To RST.RecordCount Step 1
deger = CStr(RST.Fields(0).Value)
If z.exists(deger) Then
    Sheets(sayfaadi).Cells(z.Item(deger), 3) = RST.Fields(2)
    Sheets(sayfaadi).Cells(z.Item(deger), 4) = RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) + RST.Fields(7) + RST.Fields(8) 'IRS_MIK + TES_MIK + _GIR_MIK + _URT_MIK + _ART_MIK + _RZG_MIK
    Sheets(sayfaadi).Cells(z.Item(deger), 5) = RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) + RST.Fields(13) + RST.Fields(14) ' _CIK_MIK + _IML_MIK + _EKS_MIK + _HAS_MIK + _IAD_MIK + _SAT_MIK
    Sheets(sayfaadi).Cells(z.Item(deger), 6) = (RST.Fields(2) + RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) + RST.Fields(7) + RST.Fields(8)) - (RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) + RST.Fields(13) + RST.Fields(14))
 End If
  Label1.Caption = "% " & Round(i / RST.RecordCount * 100, 0)
RST.MoveNext
Next i
Loop
RST.Close
SQLCON.Close
Range("B7").Select
End Sub

 

[a_self_lion]

Aslında burada kurulucak mantık
else bölümünde
Else
shets(sayfaadi).cells(z.Item(deger)
tam yapamadım ama burda olması gereken Rst.Fields(0).value yi deger e atıyoruz ya o bizim kodumuz z. setindede o kodlar var zaten üstte yaptığı eşleşirse verileri yeniliyor sadece.
Benim bu else bölümünde yapmak istediğm se eşleşmezse yani deger ile z. setindeki eşleşmezse setten yukarıdan aşağı doğru kodun alabileceği yere kendini satır açarak gerekli bilgileri yazdırmak sadece. ama mantığını bir türlü kuramadım. Arkadaşlar.

Do Until RST.EOF
For i = 1 To RST.RecordCount Step 1
deger = CStr(RST.Fields(0).Value)
If z.exists(deger) Then
Sheets(sayfaadi).Cells(z.Item(deger), 3) = RST.Fields(2)
Sheets(sayfaadi).Cells(z.Item(deger), 4) = RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) + RST.Fields(7) + RST.Fields(8) 'IRS_MIK + TES_MIK + _GIR_MIK + _URT_MIK + _ART_MIK + _RZG_MIK
Sheets(sayfaadi).Cells(z.Item(deger), 5) = RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) + RST.Fields(13) + RST.Fields(14) ' _CIK_MIK + _IML_MIK + _EKS_MIK + _HAS_MIK + _IAD_MIK + _SAT_MIK
Sheets(sayfaadi).Cells(z.Item(deger), 6) = (RST.Fields(2) + RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) + RST.Fields(7) + RST.Fields(8)) - (RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) + RST.Fields(13) + RST.Fields(14))

Else
shets(sayfaadi).cells(z.Item(deger)


End If

 

[Korhan Ayhan]

Selamlar,

Anlattıklarınıza göre aşağıdaki kod yapısını kullanabilirsiniz. İncelermisiniz.

Option Explicit
 
Sub ÖRNEK()
    Dim BUL As Range, Satır As Long
    
    If z.exists(deger) Then
        Sheets(sayfaadi).Cells(z.Item(deger), 3) = RST.Fields(2)
        Sheets(sayfaadi).Cells(z.Item(deger), 4) = RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) + RST.Fields(7) + RST.Fields(8) 'IRS_MIK + TES_MIK + _GIR_MIK + _URT_MIK + _ART_MIK + _RZG_MIK
        Sheets(sayfaadi).Cells(z.Item(deger), 5) = RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) + RST.Fields(13) + RST.Fields(14) ' _CIK_MIK + _IML_MIK + _EKS_MIK + _HAS_MIK + _IAD_MIK + _SAT_MIK
        Sheets(sayfaadi).Cells(z.Item(deger), 6) = (RST.Fields(2) + RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) + RST.Fields(7) + RST.Fields(8)) - (RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) + RST.Fields(13) + RST.Fields(14))
        Set BUL = Sheets(sayfaadi).Range("A:A").Find(z.Item(deger))
        If Not BUL Is Nothing Then Satır = BUL.Row
    Else
        Sheets(sayfaadi).Cells(Satır + 1, 1).EntireRow.Insert
        Sheets(sayfaadi).Cells(Satır + 1, 1) = deger
        Sheets(sayfaadi).Cells(Satır + 1, 2) = RST.Fields(2)
        '.... Bu şekilde isteğiniz kadar ekleme yapabilirsiniz.
    End If
End Sub

 

[Korhan Ayhan]

Selamlar,

Sanıyorum bir mantık hatası yaptım. Üstteki mesajımdaki kodu yeniledim. Son halini denermisiniz.

 

[a_self_lion]

Evet Korhan Bey sizin yol göstermenizle aşağıdaki gibide düzenleyince süper oldu.
Elinize sağlık.

Dim deger As String
Dim BUL As Range, Satir As Long
Satir = 7
Do Until RST.EOF
For i = 1 To RST.RecordCount Step 1
deger = CStr(RST.Fields(3).Value)
If Z.exists(deger) Then
Set BUL = Sheets(sayfaadi).Range("D").Find(deger)
If Not BUL Is Nothing Then Satir = BUL.Row
Sheets(sayfaadi).Cells(Satir, 3) = RST.Fields(2)
Sheets(sayfaadi).Cells(Satir, 4) = RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) + RST.Fields(7) + RST.Fields(8) 'IRS_MIK + TES_MIK + _GIR_MIK + _URT_MIK + _ART_MIK + _RZG_MIK
Sheets(sayfaadi).Cells(Satir, 5) = RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) + RST.Fields(13) + RST.Fields(14) ' _CIK_MIK + _IML_MIK + _EKS_MIK + _HAS_MIK + _IAD_MIK + _SAT_MIK
Sheets(sayfaadi).Cells(Satir, 6) = (RST.Fields(2) + RST.Fields(3) + RST.Fields(4) + RST.Fields(5) + RST.Fields(6) + RST.Fields(7) + RST.Fields(8)) - (RST.Fields(9) + RST.Fields(10) + RST.Fields(11) + RST.Fields(12) + RST.Fields(13) + RST.Fields(14))
Else
Sheets(sayfaadi).Cells(Satir + 1, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
Sheets(sayfaadi).Cells(Satir + 1, 1).NumberFormat = "@"
Sheets(sayfaadi).Cells(Satir + 1, 1) = CStr(deger)
Sheets(sayfaadi).Cells(Satir + 1, 2) = RST.Fields(1)
Sheets(sayfaadi).Cells(Satir + 1, 3) = RST.Fields(2)
'.... Bu şekilde isteğiniz kadar ekleme yapabilirsiniz.


End If
Set BUL = Sheets(sayfaadi).Range("A:A").Find(deger)
If Not BUL Is Nothing Then Satir = BUL.Row
Label1.Caption = "% " & Round(i / RST.RecordCount * 100, 0)