• DİKKAT

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

Karmaşık verileri düzenle hale getirme

A

arrow3441

Altın Üye
Katılım
31 Ekim 2022
Mesajlar
297
Excel Vers. ve Dili
2016
Merhaba ustadlar ekteki dosyada açıklamayı ve nasıl olması gerektigi ile ilgili çalışmayı örnek olarak yaptım yardımlarınızı istiyorum sizlerden teşekkür ederim şimdiden.
 

Ekli dosyalar

Ekli dosyada VBA/ADO ile bir alternatif hazırladım. "Rapor" isimli sayfadaki butona tıklayıp, duruma bir bakın..... ben kontrol etmedim.

.
 

Ekli dosyalar

Hocam çok teşekkür ederim süpersiniz istediğim gibi olmuş fakat çekmek istedipim depoyu değiştirince mesela AYDIN bu satırda hata veriyor
Kod: 
strSQL = "Select '" & arrBelgeNo(0, i) & "' As [BELGENO], '" & Sheets("Rapor").Range("C1") & "' As [DEPO], Sum([TOPLAM]) As [TOPLAM], Sum([NETTUTAR]) As [NETTUTAR]From [Sayfa1$] Where [BELGENO]= '" & arrBelgeNo(0, i) & "'"
Birde ek olarak PRIMTUTARI kısmında toplamı altında gösterebilirmi
 
Evet .... "KIZILAY" ve "AKTUEL"de sorun yok ama, "AYDIN" seçince bir cinslik var. Muhtemelen "Sayfa1" içinde veri uyuşmazlığı falan, bir cinslik var.

Bulursam haber veririm.

Edit: "Sayfa1" "BELGENO" sütunundaki verilerin kimisi sayısal, kimisi de metin olarak görünüyor. Sorun burdan kaynaklanıyor.

.
 
Sorun galiba şurdan kaynaklanıyor....

Belge No: "211261248376" hem KIZILAY deposunda, hem de AYDIN deposunda var. Bu doğru olabilir mi, yoksa veri yanlış mı girilmiş?

Bence olmaması gerekir mantıken, ama sizin değerlendirmeniz önemli....


.
 
Hayir, kodla ilgili bir problem vardi

.
 
Tablolarda hücrelere kenarlık eklenmesi ve başlık hücrelerinin renklendirilmesini sağlayan revize kod aşağıdadır;


Screenshot.png



C++: 
Option Explicit
'
Sub Test()
'   Haluk - 29/09/2023
'   sa4truss@gmail.com
'
    Dim objADO As ADODB.Connection
    Dim strFile As String, strSQL As String
    Dim objRS As ADODB.Recordset
    Dim arrBelgeNo As Variant
    Dim i As Integer, j As Integer, NoA As Integer, dataCount As Long
   
    NoA = Sheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
   
    For i = 2 To NoA
        Sheets("Sayfa1").Range("A" & i).Value = Sheets("Sayfa1").Range("A" & i).Value
    Next
   
    Sheets("Sayfa1").Range("A2:A" & NoA).NumberFormat = "0"
   
    Sheets("Rapor").Range("A2:K" & Rows.Count).Clear
     
    Set objADO = New ADODB.Connection
    objADO.CursorLocation = adUseClient
   
    strFile = ThisWorkbook.FullName
   
    With objADO
        If Val(Application.Version) < 14 Then
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Properties("Extended Properties") = "Excel 8.0; HDR=Yes;IMEX=1;"
        Else
            .Provider = "Microsoft.Ace.OLEDB.12.0"
            .Properties("Extended Properties") = "Excel 12.0; HDR=Yes;IMEX=1;"
        End If
       .ConnectionString = strFile
       .Open
    End With
   
    Set objRS = New ADODB.Recordset
    strSQL = " Select Distinct [BELGENO] From [Sayfa1$] Where [DEPO]= '" & Sheets("Rapor").Range("C1") & "'"
   
    Set objRS = objADO.Execute(strSQL)
    dataCount = objRS.RecordCount
       
    arrBelgeNo = objRS.GetRows(, , "BELGENO")
   
    For i = 0 To dataCount - 1
        NoA = Sheets("Rapor").Range("A" & Rows.Count).End(xlUp).Row + 1

        strSQL = "Select '" & arrBelgeNo(0, i) & "' As [BELGENO], '" & Sheets("Rapor").Range("C1") & "' As [DEPO], Sum([TOPLAM]) As [TOPLAM], Sum([NETTUTAR]) As [NETTUTAR]From [Sayfa1$] Where [BELGENO]= " & arrBelgeNo(0, i) & " And [DEPO]= '" & Sheets("Rapor").Range("C1") & "'"

        Set objRS = objADO.Execute(strSQL)
               
        For j = 0 To objRS.Fields.Count - 1
            Sheets("Rapor").Cells(NoA + 2, j + 1) = objRS.Fields(j).Name
            Sheets("Rapor").Cells(NoA + 2, j + 1).Font.Bold = True
        Next
               
        Sheets("Rapor").Range("A" & NoA + 3).CopyFromRecordset objRS
        Sheets("Rapor").Range("A" & NoA + 2 & ":D" & NoA + 2).Interior.Color = RGB(212, 212, 212)
        Sheets("Rapor").Range("A" & NoA + 2 & ":D" & NoA + 2 + objRS.RecordCount).Borders.LineStyle = xlContinuous
       
        strSQL = "Select [STOKKODU], [MALINCINSI], [MIKTAR], [SATISFIYATI], [ISK1], [DURUM], [PRIM], [TOPLAM], [NETTUTAR], [PRIMTUTARI], [PERKODU] " & _
                 "From [Sayfa1$] Where [BELGENO]= " & arrBelgeNo(0, i) & " And [DEPO]= '" & Sheets("Rapor").Range("C1") & "'"
       
        Set objRS = objADO.Execute(strSQL)
       
        For j = 0 To objRS.Fields.Count - 1
            Sheets("Rapor").Cells(NoA + 4, j + 1) = objRS.Fields(j).Name
            Sheets("Rapor").Range(Cells(NoA + 4, j + 1).Address).Font.Bold = True
        Next
       
        Sheets("Rapor").Range("A" & NoA + 5).CopyFromRecordset objRS
        Sheets("Rapor").Range("A" & NoA + 4 & ":K" & NoA + 4 + objRS.RecordCount).Borders.LineStyle = xlContinuous
        Sheets("Rapor").Range("A" & NoA + 4 & ":K" & NoA + 4).Interior.Color = RGB(212, 212, 212)
    Next
           
    If objRS.State = adStateOpen Then objRS.Close
    If objADO.State = adStateOpen Then objADO.Close
   
    Set objRS = Nothing
    Set objADO = Nothing
End Sub

.
 
SQL sorgusuna ilaveyle halledildi.....


.
 

Ekli dosyalar

@Haluk hocam 1000 satırlık veri olunca işlem süresi 70 saniye oluyor daha kısa sürede işlem yapılabilrmi acaba? Veriler 5000 satır olabilir oyuzden
 
Pek sanmıyorum çünkü çok fazla işlem yapılıyor tabloları oluşturmak için....

Örneğin, en son yapılan revizyon (tabloların altında prim tutarlarının toplamının alınması) için SQL'de kullanılan UNION ayrı bir yük getirir. Muhtemelen 12 No'lu mesajdaki kod daha hızlı olur. Çünkü; son revizyonda UNION komutundan dolayı veriler metinsel olarak geldiği için onları nümerik hale getirmek üzere tüm hücrelerde çalışan ayrı bir For-Next döngüsü kullanıldı ki, bu yavaşlamaya sebep olur...

.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst