Ado sorgu sonucu biçimlendirme

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Ado sorgu sonucu biçimlendirme

İleti#1)  tdemirhan » 09 Mar 2020 11:26

Merhaba arkadaşlar;

Gün geçmiyor ki bu vba beni yine bir çıkmaz yola sürüklemesin. Aşağıda kodların bir kısmını paylaştığım sorunum şu şekilde;

Yanyana hücrede 3 adet ondalıklı sayıyı sorgulayıp çalışma sayfama getirmek istiyorum. Lakin her ne kadar veri hücrelerini istemer metin yapayım, ister sayı, ister genel hangi biçimlendirmeyi kullansam, ilk ikisi metin olarak son işaretli ise ondalıklı sayı olarak geliyor. Metin olarak geldiğinde ondalık virgülü kaldırıp tam bir sayı gibi davranıyor. Bana gerekli olan ise üçüncü rakamın geldiği gibi ondalıklı olarak gelmesi. Yardımlarınız için şimdide teşekkürler.

Kod: Tümünü seç
Set con = VBA.CreateObject("adodb.Connection")
        Set rs = VBA.CreateObject("adodb.Recordset")
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=Yes;Imex=1"""

'-------------------------------------------------------------------------------------
    hesaplama.Cells(5, 1) = osos.Cells(3, 2)
   
        sorgu = "Select  [GERÇEK BÖLGE] , [KURULGÇ] , [ÇARPAN] , [GÜNDÜZ] , [PUANT] , [GECE] , [SONOKUMATR] , [TRF] From [MBS$4:60536] "
        sorgu = sorgu & "where [TESISAT] = '" & hesaplama.Cells(5, 1) & "'"
        rs.Open sorgu, con
       
        Do While Not rs.EOF
        csi0 = rs(0).Value
        csi1 = rs(1).Value
        csi2 = rs(2).Value
        csi3 = rs(3).Value 'hücrede sayı olarakta biçimlense metin olarakta biçimlense sonuç metin olarak geliyor
        csi4 = rs(4).Value 'hücrede sayı olarakta biçimlense metin olarakta biçimlense sonuç metin olarak geliyor
        csi5 = rs(5).Value 'hücrede sayı olarakta biçimlense metin olarakta biçimlense sonuç sayı olarak geliyor
        csi6 = rs(6).Value
        csi7 = rs(7).Value
        'csirs(i) = rs.GetRows
        rs.movenext
        Loop
        hesaplama.Cells(5, 2) = csi7
        hesaplama.Cells(5, 3) = csi0
        hesaplama.Cells(5, 4) = csi6
        hesaplama.Cells(5, 7) = csi1 / 1000
        hesaplama.Cells(5, 16) = csi3 'sonuç virgülü ortadan kaldırarak yazıyor
        hesaplama.Cells(5, 17) = csi4 'sonuç virgülü ortadan kaldırarak yazıyor
        hesaplama.Cells(5, 18) = csi5 'sonuç her şekilde virgüllü sayı yazıyor istediğim gibi.
        hesaplama.Cells(5, 13) = csi2
        hesaplama.Cells(5, 10) = hesaplama.Cells(5, 16) + hesaplama.Cells(5, 17) + hesaplama.Cells(5, 18)

Kullanıcı avatarı
tdemirhan
Yeni Başlamış
 
Kayıt: 11 Nis 2019 15:43
Meslek: teniker
Yaş: 32
İleti: 61
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Denizli/Merkezefendi

Cevap: Ado sorgu sonucu biçimlendirme

İleti#2)  tdemirhan » 09 Mar 2020 15:59

Arkadaşlar konuyu biraz daha açayım değerler başka sayfada şu şekilde;

11591,688 67623,439 179669,56

bu hücreleri metin olarak veya sayı olarak biçimlersem eğer gelen sonuç;
11591688 67623439 179669,56

format([GUNDUZ], '#,##0,00') olarak sorgu yaparsam sonuç;

12 68 179669,56

Aslında istediğim;

11591,688 67623,439 179669,56
Kullanıcı avatarı
tdemirhan
Yeni Başlamış
 
Kayıt: 11 Nis 2019 15:43
Meslek: teniker
Yaş: 32
İleti: 61
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Denizli/Merkezefendi

Cevap: Ado sorgu sonucu biçimlendirme

İleti#3)  Ali ÖZ » 10 Mar 2020 22:40

Merhaba,
Bağlantı cümlesindeki Imex=1 i kaldırıp deneyin.
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 10:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 38
İleti: 10096
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA

Cevap: Cevap: Ado sorgu sonucu biçimlendirme

İleti#4)  otikilo » 10 Mar 2020 22:48

ali bey merhaba

öncelikle yanlış yerden bilgi soruyor olabilirim yeni olduğum için hoşgörünüze sığınıyorum.

Sub Gizle()
For Each t In Range("G3,G4,A22,G23:G25,A26,G27:G29,A30,G31:G33,A49:A51").Cells
If t.Value = "" Then 'boş hücreleri gizler
t.EntireRow.Hidden = True
End If
Next t
End Sub
Sub Goster()
Range("G3,G4,A22,G23:G25,A26,G27:G29,A30,G31:G33,A49:A51").Select
Selection.EntireRow.Hidden = False
End Sub

bu işlemde neden sadece g25, g29 ve g33 gizlenmiyor. diğerlerinde problem yok ancak bu 3 hücrede neden sıkıntı çıkıyor. destekleriniz için şimdiden teşekkür ediyorum.
Kullanıcı avatarı
otikilo
 
Kayıt: 02 Mar 2020 14:54
Meslek: kamu çalışanı
Yaş: 42
İleti: 2
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: yozgat

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Cevap: Cevap: Ado sorgu sonucu biçimlendirme

İleti#5)  Miraç CAN » 11 Mar 2020 07:29

otikilo yazdı:ali bey merhaba

öncelikle yanlış yerden bilgi soruyor olabilirim yeni olduğum için hoşgörünüze sığınıyorum.

Sub Gizle()
For Each t In Range("G3,G4,A22,G23:G25,A26,G27:G29,A30,G31:G33,A49:A51").Cells
If t.Value = "" Then 'boş hücreleri gizler
t.EntireRow.Hidden = True
End If
Next t
End Sub
Sub Goster()
Range("G3,G4,A22,G23:G25,A26,G27:G29,A30,G31:G33,A49:A51").Select
Selection.EntireRow.Hidden = False
End Sub

bu işlemde neden sadece g25, g29 ve g33 gizlenmiyor. diğerlerinde problem yok ancak bu 3 hücrede neden sıkıntı çıkıyor. destekleriniz için şimdiden teşekkür ediyorum.

Hücre verisi içeriğini kontrol edin, her ne kadar aynı gibi görünse de t = "" / t = Empty / t = " " farklılık arz ederler.
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

Cevap: Cevap: Ado sorgu sonucu biçimlendirme

İleti#6)  tdemirhan » 11 Mar 2020 08:45

Ali ÖZ yazdı:Merhaba,
Bağlantı cümlesindeki Imex=1 i kaldırıp deneyin.


Ali Bey merhaba;

İlginiz için teşekkür ederim. Imex=1 ifadesini kaldırdıktan sonrada sonuç değişmedi maalesef,
Kod: Tümünü seç
rs(3).value
ve
Kod: Tümünü seç
rs(4).value
kaynak hücrelerde ondalıklı sayı olduğu halde, ondalığı kaldırarak tam sayı gelmeye devam ediyor.
Kullanıcı avatarı
tdemirhan
Yeni Başlamış
 
Kayıt: 11 Nis 2019 15:43
Meslek: teniker
Yaş: 32
İleti: 61
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Denizli/Merkezefendi

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Cevap: Cevap: Ado sorgu sonucu biçimlendirme

İleti#7)  Ali ÖZ » 11 Mar 2020 12:48

tdemirhan yazdı:
Ali ÖZ yazdı:Merhaba,
Bağlantı cümlesindeki Imex=1 i kaldırıp deneyin.


Ali Bey merhaba;

İlginiz için teşekkür ederim. Imex=1 ifadesini kaldırdıktan sonrada sonuç değişmedi maalesef,
Kod: Tümünü seç
rs(3).value
ve
Kod: Tümünü seç
rs(4).value
kaynak hücrelerde ondalıklı sayı olduğu halde, ondalığı kaldırarak tam sayı gelmeye devam ediyor.


Dosyanızı ekler misiniz.
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 10:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 38
İleti: 10096
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA

Cevap: Cevap: Cevap: Cevap: Ado sorgu sonucu biçimlendirme

İleti#8)  otikilo » 11 Mar 2020 13:24

ilgi ve alakanıza çok teşekkür ediyorum. saygılarımla
Kullanıcı avatarı
otikilo
 
Kayıt: 02 Mar 2020 14:54
Meslek: kamu çalışanı
Yaş: 42
İleti: 2
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: yozgat

Cevap: Cevap: Cevap: Cevap: Ado sorgu sonucu biçimlendirme

İleti#9)  tdemirhan » 12 Mar 2020 07:40

Ali ÖZ yazdı:
tdemirhan yazdı:
Ali ÖZ yazdı:Merhaba,
Bağlantı cümlesindeki Imex=1 i kaldırıp deneyin.


Ali Bey merhaba;

İlginiz için teşekkür ederim. Imex=1 ifadesini kaldırdıktan sonrada sonuç değişmedi maalesef,
Kod: Tümünü seç
rs(3).value
ve
Kod: Tümünü seç
rs(4).value
kaynak hücrelerde ondalıklı sayı olduğu halde, ondalığı kaldırarak tam sayı gelmeye devam ediyor.


Dosyanızı ekler misiniz.


Buyrun Ali Bey.
Kullanıcı avatarı
tdemirhan
Yeni Başlamış
 
Kayıt: 11 Nis 2019 15:43
Meslek: teniker
Yaş: 32
İleti: 61
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Denizli/Merkezefendi

Cevap: Ado sorgu sonucu biçimlendirme

İleti#10)  Ali ÖZ » 12 Mar 2020 12:46

En sona bu satırı ekleyin.
Kod: Tümünü seç
Sheets("hesaplama").Columns("P:R").NumberFormat = "0.000"
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 10:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 38
İleti: 10096
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA

Cevap: Cevap: Ado sorgu sonucu biçimlendirme

İleti#11)  tdemirhan » 12 Mar 2020 16:06

Ali ÖZ yazdı:En sona bu satırı ekleyin.
Kod: Tümünü seç
Sheets("hesaplama").Columns("P:R").NumberFormat = "0.000"


Teşekkür ederim Ali Bey bunu hemen deneyeceğim lakin dosyayı sizin için upload etmiştim konuya dosyaya bakabildiyseniz eğer kaldırabilir misiniz? Zira bazı bilgiler mevcut sorun çıkarabilir benim için.
Kullanıcı avatarı
tdemirhan
Yeni Başlamış
 
Kayıt: 11 Nis 2019 15:43
Meslek: teniker
Yaş: 32
İleti: 61
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Denizli/Merkezefendi

Cevap: Ado sorgu sonucu biçimlendirme

İleti#12)  tdemirhan » 13 Mar 2020 16:20

Ali Bey önermiş olduğunuz kodu denedim ama yine sonuç değişmedi. Fakat şöyle birşey denedim. sorgu sonuçlarını değişkenlere atamadan doğrudan herhangi bir hücre belirtip o hücreye yazmasını istediğimde sonuç istediğim gibi geliyor. Değişkene atadığım ise bu sonuç tam sayı olarak geliyor.
sonuç.jpg
bu değişkene atadığımda aldığım sonuç,
sonuç2.jpg
burada ise recordset i doğruda hücreye yazdırmak istediğimde aldığım sonuç, sanırım değişken atamasında bir hata yaptım diye düşünerek değişkenleri tanımladım ama yine sonuç değişmedi.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
tdemirhan
Yeni Başlamış
 
Kayıt: 11 Nis 2019 15:43
Meslek: teniker
Yaş: 32
İleti: 61
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Denizli/Merkezefendi

Cevap: Ado sorgu sonucu biçimlendirme

İleti#13)  tdemirhan » 13 Mar 2020 16:36

Özür dilerim arka arkaya iletiler oldu ama birşeyler denedikçe farklı bir bakış açısı olur diyerek sonuçları yazmaya çalışıyorum.
pausebreak.jpg

pause break yaparak satır satır ilerlediğimde üstteki resimde olduğu gibi değişkene doğru atadığını görüyorum fakat sayfadaki hedef hücrede neden değiştiğini anlamış değilim. Değişkene atamadan doğrudan hücreyi hedef gösterdiğimde de yine bütün bir tamsayı olarak yazıyor.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
tdemirhan
Yeni Başlamış
 
Kayıt: 11 Nis 2019 15:43
Meslek: teniker
Yaş: 32
İleti: 61
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Denizli/Merkezefendi

Cevap: Ado sorgu sonucu biçimlendirme

İleti#14)  Ali ÖZ » 13 Mar 2020 22:07

Deneyin.

Kod: Tümünü seç
Sub seyt_hesaplama()
Dim g, a, y, i, z, ay, csi7, csi1, csi2 As Integer
Dim b, csi, cst As Double
Dim csi0 As Variant
Dim csi6 As Date
Dim hesaplama As Worksheet: Set hesaplama = Sheets("hesaplama")
Dim csaat As Worksheet: Set csaat = Sheets("çalışma saatleri")
Dim mbs As Worksheet: Set modul = Sheets("MBS")
Dim osos As Worksheet: Set osos = Sheets("OSOS")

        Set con = VBA.CreateObject("adodb.Connection")
        Set rs = VBA.CreateObject("adodb.Recordset")
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=Yes"""

'---------------------------------------------------------------- MBS sayfasından veri alır
    hesaplama.Cells(5, 1) = osos.Cells(3, 2)
   
        sorgu = "Select  [GERÇEK BÖLGE] , [KURULGÇ] , [ÇARPAN] , [GÜNDÜZ] , [PUANT] , [GECE] , [SONOKUMATR] , [TRF] From [MBS$4:60536] "
        sorgu = sorgu & "where [TESISAT] = '" & hesaplama.Cells(5, 1) & "'"
        rs.Open sorgu, con
       
        Do While Not rs.EOF
        csi0 = rs(0).Value
        csi1 = rs(1).Value
        csi2 = rs(2).Value
        csi3 = rs(3).Value 'hücrede sayı olarakta biçimlense metin olarakta biçimlense sonuç metin olarak geliyor
        csi4 = rs(4).Value 'hücrede sayı olarakta biçimlense metin olarakta biçimlense sonuç metin olarak geliyor
        csi5 = rs(5).Value 'hücrede sayı olarakta biçimlense metin olarakta biçimlense sonuç sayı olarak geliyor
        csi6 = rs(6).Value
        csi7 = rs(7).Value
        'csirs(i) = rs.GetRows
        rs.movenext
        Loop
        hesaplama.Cells(5, 2) = csi7
        hesaplama.Cells(5, 3) = csi0
        hesaplama.Cells(5, 4) = csi6
        hesaplama.Cells(5, 7) = csi1 / 1000
        hesaplama.Cells(5, 16) = CDbl(csi3) 'sonuç virgülü ortadan kaldırarak yazıyor
        hesaplama.Cells(5, 17) = CDbl(csi4) 'sonuç virgülü ortadan kaldırarak yazıyor
        hesaplama.Cells(5, 18) = CDbl(csi5) 'sonuç her şekilde virgüllü sayı yazıyor istediğim gibi.
        hesaplama.Cells(5, 13) = csi2
        hesaplama.Cells(5, 10) = hesaplama.Cells(5, 16) + hesaplama.Cells(5, 17) + hesaplama.Cells(5, 18)

        con.Close: Set con = Nothing: Set rs = Nothing
'--------------------------------------------------- Osos sayfasından veri almak için buradan devam et.
       
        Set con = VBA.CreateObject("adodb.Connection")
        Set rs = VBA.CreateObject("adodb.Recordset")
        sorgu = "Select  [GERÇEK BÖLGE] , [KURULGÇ] , [ÇARPAN] , [GÜNDÜZ] , [PUANT] , [GECE] , [SONOKUMATR] , [TRF] From [MBS$4:60536] "
        sorgu = sorgu & "where [TESISAT] = '" & hesaplama.Cells(5, 1) & "'"
        rs.Open sorgu, con
       
'----------------------------------------------------------------------------

    hesaplama.Cells(5, 6) = hesaplama.Cells(5, 5) - hesaplama.Cells(5, 4)

    If hesaplama.Cells(5, 6) = Day(hesaplama.Cells(5, 5)) Or hesaplama.Cells(5, 6) < 0 Then
        g = Day(hesaplama.Cells(5, 5))
        a = Month(hesaplama.Cells(5, 5))
        y = Year(hesaplama.Cells(5, 5))
        b = a
        sorgu = "Select  [" & a & "] From [çalışma saatleri$1:60536] "
        sorgu = sorgu & "where [YIL] = '" & y & "'"
        rs.Open sorgu, con
        'If rs.RecordCount > 0 Then csi.CopyFromRecordset rs
   
        Do While Not rs.EOF
        csi = rs(0).Value
        rs.movenext
        Loop
   
        cst = g * csi
        hesaplama.Cells(5, 8) = cst
       
        If hesaplama.Cells(5, 2).Value = "504" Or hesaplama.Cells(5, 2).Value = "519" Then
            hesaplama.Cells(5, 9) = 24 * hesaplama.Cells(5, 6) * hesaplama.Cells(5, 7) * 1.04
        Else
            hesaplama.Cells(5, 9) = cst * hesaplama.Cells(5, 7) * 1.04
        End If
       
        hesaplama.Cells(5, 12) = hesaplama.Cells(5, 11) - hesaplama.Cells(5, 10)
        hesaplama.Cells(5, 14) = hesaplama.Cells(5, 13) * hesaplama.Cells(5, 12)
        hesaplama.Cells(5, 15) = hesaplama.Cells(5, 14) - hesaplama.Cells(5, 9)
        hesaplama.Cells(5, 22) = hesaplama.Cells(5, 19)
        hesaplama.Cells(5, 23) = hesaplama.Cells(5, 20)

        If hesaplama.Cells(5, 15) > 0 Then
            If hesaplama.Cells(5, 21) - hesaplama.Cells(5, 15) - (3 / hesaplama.Cells(5, 13)) < hesaplama.Cells(5, 18) Then
                hesaplama.Cells(5, 24) = hesaplama.Cells(5, 18)
            Else
                hesaplama.Cells(5, 24) = hesaplama.Cells(5, 21) - hesaplama.Cells(5, 15) - (3 / hesaplama.Cells(5, 13))
            End If
        Else
            hesaplama.Cells(5, 24) = hesaplama.Cells(5, 21)
        End If
   
        hesaplama.Cells(5, 25) = hesaplama.Cells(5, 22) + hesaplama.Cells(5, 23) + hesaplama.Cells(5, 24)
        hesaplama.Cells(5, 26) = hesaplama.Cells(5, 25) - hesaplama.Cells(5, 10)
        hesaplama.Cells(5, 27) = hesaplama.Cells(5, 26) * hesaplama.Cells(5, 13)
        hesaplama.Cells(5, 28) = hesaplama.Cells(5, 27) - hesaplama.Cells(5, 9)

    Else
        Dim gun, d As Integer '------------------ Gün-çalışma saati hesaplama
        Dim c As Date
        Dim csd As Double
        gun = hesaplama.Cells(5, 6)
        d = Month(hesaplama.Cells(5, 5))
        c = hesaplama.Cells(5, 5)
        csi = 0

        Do Until gun < Day(c)
            sorgu = "Select  [" & Month(c) & "] From [çalışma saatleri$1:60536] "
            sorgu = sorgu & "where [YIL] = '" & Year(c) & "'"
            rs.Open sorgu, con
   
            Do While Not rs.EOF
                csd = rs(0).Value
                rs.movenext
            Loop
            rs.Close
       
            csi = csi + Day(c) * csd
            gun = gun - Day(c)
            c = c - Day(c)
        Loop
       
        sorgu = "Select  [" & Month(c) & "] From [çalışma saatleri$1:60536] "
        sorgu = sorgu & "where [YIL] = '" & Year(c) & "'"
        rs.Open sorgu, con
       
        Do While Not rs.EOF
        csd = rs(0).Value
        rs.movenext
        Loop
   
        csi = csi + gun * csd
   
        hesaplama.Cells(5, 8) = csi
   
        If hesaplama.Cells(5, 2).Value = "504" Or hesaplama.Cells(5, 2).Value = "519" Then
            hesaplama.Cells(5, 9) = 24 * hesaplama.Cells(5, 6) * hesaplama.Cells(5, 7) * 1.04
        Else
            hesaplama.Cells(5, 9) = csi * hesaplama.Cells(5, 7) * 1.04
        End If
       
        hesaplama.Cells(5, 12) = hesaplama.Cells(5, 11) - hesaplama.Cells(5, 10)
        hesaplama.Cells(5, 14) = hesaplama.Cells(5, 13) * hesaplama.Cells(5, 12)
        hesaplama.Cells(5, 15) = hesaplama.Cells(5, 14) - hesaplama.Cells(5, 9)
        hesaplama.Cells(5, 22) = hesaplama.Cells(5, 19)
        hesaplama.Cells(5, 23) = hesaplama.Cells(5, 20)

        If hesaplama.Cells(5, 15) > 0 Then
            If hesaplama.Cells(5, 21) - hesaplama.Cells(5, 15) - (3 / hesaplama.Cells(5, 13)) < hesaplama.Cells(5, 18) Then
                hesaplama.Cells(5, 24) = hesaplama.Cells(5, 18)
            Else
                hesaplama.Cells(5, 24) = hesaplama.Cells(5, 21) - hesaplama.Cells(5, 15) - (3 / hesaplama.Cells(5, 13))
            End If
        Else
            hesaplama.Cells(5, 24) = hesaplama.Cells(5, 21)
        End If
   
        hesaplama.Cells(5, 25) = hesaplama.Cells(5, 22) + hesaplama.Cells(5, 23) + hesaplama.Cells(5, 24)
        hesaplama.Cells(5, 26) = hesaplama.Cells(5, 25) - hesaplama.Cells(5, 10)
        hesaplama.Cells(5, 27) = hesaplama.Cells(5, 26) * hesaplama.Cells(5, 13)
        hesaplama.Cells(5, 28) = hesaplama.Cells(5, 27) - hesaplama.Cells(5, 9)
   
    End If
End Sub
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 10:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 38
İleti: 10096
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA

Cevap: Cevap: Ado sorgu sonucu biçimlendirme

İleti#15)  tdemirhan » 14 Mar 2020 14:52

Ali ÖZ yazdı:Deneyin.

Kod: Tümünü seç
Sub seyt_hesaplama()
Dim g, a, y, i, z, ay, csi7, csi1, csi2 As Integer
Dim b, csi, cst As Double
Dim csi0 As Variant
Dim csi6 As Date
Dim hesaplama As Worksheet: Set hesaplama = Sheets("hesaplama")
Dim csaat As Worksheet: Set csaat = Sheets("çalışma saatleri")
Dim mbs As Worksheet: Set modul = Sheets("MBS")
Dim osos As Worksheet: Set osos = Sheets("OSOS")

        Set con = VBA.CreateObject("adodb.Connection")
        Set rs = VBA.CreateObject("adodb.Recordset")
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=Yes"""

'---------------------------------------------------------------- MBS sayfasından veri alır
    hesaplama.Cells(5, 1) = osos.Cells(3, 2)
   
        sorgu = "Select  [GERÇEK BÖLGE] , [KURULGÇ] , [ÇARPAN] , [GÜNDÜZ] , [PUANT] , [GECE] , [SONOKUMATR] , [TRF] From [MBS$4:60536] "
        sorgu = sorgu & "where [TESISAT] = '" & hesaplama.Cells(5, 1) & "'"
        rs.Open sorgu, con
       
        Do While Not rs.EOF
        csi0 = rs(0).Value
        csi1 = rs(1).Value
        csi2 = rs(2).Value
        csi3 = rs(3).Value 'hücrede sayı olarakta biçimlense metin olarakta biçimlense sonuç metin olarak geliyor
        csi4 = rs(4).Value 'hücrede sayı olarakta biçimlense metin olarakta biçimlense sonuç metin olarak geliyor
        csi5 = rs(5).Value 'hücrede sayı olarakta biçimlense metin olarakta biçimlense sonuç sayı olarak geliyor
        csi6 = rs(6).Value
        csi7 = rs(7).Value
        'csirs(i) = rs.GetRows
        rs.movenext
        Loop
        hesaplama.Cells(5, 2) = csi7
        hesaplama.Cells(5, 3) = csi0
        hesaplama.Cells(5, 4) = csi6
        hesaplama.Cells(5, 7) = csi1 / 1000
        hesaplama.Cells(5, 16) = CDbl(csi3) 'sonuç virgülü ortadan kaldırarak yazıyor
        hesaplama.Cells(5, 17) = CDbl(csi4) 'sonuç virgülü ortadan kaldırarak yazıyor
        hesaplama.Cells(5, 18) = CDbl(csi5) 'sonuç her şekilde virgüllü sayı yazıyor istediğim gibi.
        hesaplama.Cells(5, 13) = csi2
        hesaplama.Cells(5, 10) = hesaplama.Cells(5, 16) + hesaplama.Cells(5, 17) + hesaplama.Cells(5, 18)

        con.Close: Set con = Nothing: Set rs = Nothing
'--------------------------------------------------- Osos sayfasından veri almak için buradan devam et.
       
        Set con = VBA.CreateObject("adodb.Connection")
        Set rs = VBA.CreateObject("adodb.Recordset")
        sorgu = "Select  [GERÇEK BÖLGE] , [KURULGÇ] , [ÇARPAN] , [GÜNDÜZ] , [PUANT] , [GECE] , [SONOKUMATR] , [TRF] From [MBS$4:60536] "
        sorgu = sorgu & "where [TESISAT] = '" & hesaplama.Cells(5, 1) & "'"
        rs.Open sorgu, con
       
'----------------------------------------------------------------------------

    hesaplama.Cells(5, 6) = hesaplama.Cells(5, 5) - hesaplama.Cells(5, 4)

    If hesaplama.Cells(5, 6) = Day(hesaplama.Cells(5, 5)) Or hesaplama.Cells(5, 6) < 0 Then
        g = Day(hesaplama.Cells(5, 5))
        a = Month(hesaplama.Cells(5, 5))
        y = Year(hesaplama.Cells(5, 5))
        b = a
        sorgu = "Select  [" & a & "] From [çalışma saatleri$1:60536] "
        sorgu = sorgu & "where [YIL] = '" & y & "'"
        rs.Open sorgu, con
        'If rs.RecordCount > 0 Then csi.CopyFromRecordset rs
   
        Do While Not rs.EOF
        csi = rs(0).Value
        rs.movenext
        Loop
   
        cst = g * csi
        hesaplama.Cells(5, 8) = cst
       
        If hesaplama.Cells(5, 2).Value = "504" Or hesaplama.Cells(5, 2).Value = "519" Then
            hesaplama.Cells(5, 9) = 24 * hesaplama.Cells(5, 6) * hesaplama.Cells(5, 7) * 1.04
        Else
            hesaplama.Cells(5, 9) = cst * hesaplama.Cells(5, 7) * 1.04
        End If
       
        hesaplama.Cells(5, 12) = hesaplama.Cells(5, 11) - hesaplama.Cells(5, 10)
        hesaplama.Cells(5, 14) = hesaplama.Cells(5, 13) * hesaplama.Cells(5, 12)
        hesaplama.Cells(5, 15) = hesaplama.Cells(5, 14) - hesaplama.Cells(5, 9)
        hesaplama.Cells(5, 22) = hesaplama.Cells(5, 19)
        hesaplama.Cells(5, 23) = hesaplama.Cells(5, 20)

        If hesaplama.Cells(5, 15) > 0 Then
            If hesaplama.Cells(5, 21) - hesaplama.Cells(5, 15) - (3 / hesaplama.Cells(5, 13)) < hesaplama.Cells(5, 18) Then
                hesaplama.Cells(5, 24) = hesaplama.Cells(5, 18)
            Else
                hesaplama.Cells(5, 24) = hesaplama.Cells(5, 21) - hesaplama.Cells(5, 15) - (3 / hesaplama.Cells(5, 13))
            End If
        Else
            hesaplama.Cells(5, 24) = hesaplama.Cells(5, 21)
        End If
   
        hesaplama.Cells(5, 25) = hesaplama.Cells(5, 22) + hesaplama.Cells(5, 23) + hesaplama.Cells(5, 24)
        hesaplama.Cells(5, 26) = hesaplama.Cells(5, 25) - hesaplama.Cells(5, 10)
        hesaplama.Cells(5, 27) = hesaplama.Cells(5, 26) * hesaplama.Cells(5, 13)
        hesaplama.Cells(5, 28) = hesaplama.Cells(5, 27) - hesaplama.Cells(5, 9)

    Else
        Dim gun, d As Integer '------------------ Gün-çalışma saati hesaplama
        Dim c As Date
        Dim csd As Double
        gun = hesaplama.Cells(5, 6)
        d = Month(hesaplama.Cells(5, 5))
        c = hesaplama.Cells(5, 5)
        csi = 0

        Do Until gun < Day(c)
            sorgu = "Select  [" & Month(c) & "] From [çalışma saatleri$1:60536] "
            sorgu = sorgu & "where [YIL] = '" & Year(c) & "'"
            rs.Open sorgu, con
   
            Do While Not rs.EOF
                csd = rs(0).Value
                rs.movenext
            Loop
            rs.Close
       
            csi = csi + Day(c) * csd
            gun = gun - Day(c)
            c = c - Day(c)
        Loop
       
        sorgu = "Select  [" & Month(c) & "] From [çalışma saatleri$1:60536] "
        sorgu = sorgu & "where [YIL] = '" & Year(c) & "'"
        rs.Open sorgu, con
       
        Do While Not rs.EOF
        csd = rs(0).Value
        rs.movenext
        Loop
   
        csi = csi + gun * csd
   
        hesaplama.Cells(5, 8) = csi
   
        If hesaplama.Cells(5, 2).Value = "504" Or hesaplama.Cells(5, 2).Value = "519" Then
            hesaplama.Cells(5, 9) = 24 * hesaplama.Cells(5, 6) * hesaplama.Cells(5, 7) * 1.04
        Else
            hesaplama.Cells(5, 9) = csi * hesaplama.Cells(5, 7) * 1.04
        End If
       
        hesaplama.Cells(5, 12) = hesaplama.Cells(5, 11) - hesaplama.Cells(5, 10)
        hesaplama.Cells(5, 14) = hesaplama.Cells(5, 13) * hesaplama.Cells(5, 12)
        hesaplama.Cells(5, 15) = hesaplama.Cells(5, 14) - hesaplama.Cells(5, 9)
        hesaplama.Cells(5, 22) = hesaplama.Cells(5, 19)
        hesaplama.Cells(5, 23) = hesaplama.Cells(5, 20)

        If hesaplama.Cells(5, 15) > 0 Then
            If hesaplama.Cells(5, 21) - hesaplama.Cells(5, 15) - (3 / hesaplama.Cells(5, 13)) < hesaplama.Cells(5, 18) Then
                hesaplama.Cells(5, 24) = hesaplama.Cells(5, 18)
            Else
                hesaplama.Cells(5, 24) = hesaplama.Cells(5, 21) - hesaplama.Cells(5, 15) - (3 / hesaplama.Cells(5, 13))
            End If
        Else
            hesaplama.Cells(5, 24) = hesaplama.Cells(5, 21)
        End If
   
        hesaplama.Cells(5, 25) = hesaplama.Cells(5, 22) + hesaplama.Cells(5, 23) + hesaplama.Cells(5, 24)
        hesaplama.Cells(5, 26) = hesaplama.Cells(5, 25) - hesaplama.Cells(5, 10)
        hesaplama.Cells(5, 27) = hesaplama.Cells(5, 26) * hesaplama.Cells(5, 13)
        hesaplama.Cells(5, 28) = hesaplama.Cells(5, 27) - hesaplama.Cells(5, 9)
   
    End If
End Sub


Ali Bey çok teşekkür ederim elinize sağlık bu defa oldu, tür dönüştürme işlevlerinden her zaman bir şekilde uzak kalıyorum gram aklımın ucundan bile geçmiyor çoğu zaman, halbuki Feyzullah Bey'in bir çalışmamda yardımı dokunmuş ve "CDate" fonksiyonu ile tanışmıştım. Şu an sizin sayenizde de tür dönüştürme işlemlerinde değeri tanımlamaya zorlamanın önemini daha çok farkettim. Çok sağolun tekrar.
Kullanıcı avatarı
tdemirhan
Yeni Başlamış
 
Kayıt: 11 Nis 2019 15:43
Meslek: teniker
Yaş: 32
İleti: 61
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Denizli/Merkezefendi

Cevap: Ado sorgu sonucu biçimlendirme

İleti#16)  Erkan Akayay » 17 Mar 2020 09:02

Aman şuna dikkat edin.

Kod: Tümünü seç
Dim g, a, y, i, z, ay, csi7, csi1, csi2 As Integer
Dim b, csi, cst As Double


Dim b,csi ,cst as Double satırını örmek alalım.

Sadece cst double tanımlanmıştır. b ve csi varyant olarak tanımlanır.

Hepsi double olsun isteniyorsa, Dim b as double, csi as double, cst as double şeklinde yazılmalıdır.

Dim ile değişken tanımlanırken as ile atanmayan her değişken varyanttır.
Sorularınızı düzgün bir Türkçe ile, detay vererek ve örnek dosyayla destekleyerek sorunuz.
Örnek dosyalarınızda Application.Visible veya hide gibi sayfa gizlemelerini iptal ediniz.
Kullanıcı avatarı
Erkan Akayay
Site Dostu
 
Kayıt: 20 Ağu 2008 11:59
Konum: YALOVA
Meslek: Bilgi İşlem
Yaş: 50
İleti: 4065
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Cevap: Ado sorgu sonucu biçimlendirme

İleti#17)  tdemirhan » 22 Mar 2020 18:07

Erkan Akayay yazdı:Aman şuna dikkat edin.

Kod: Tümünü seç
Dim g, a, y, i, z, ay, csi7, csi1, csi2 As Integer
Dim b, csi, cst As Double


Dim b,csi ,cst as Double satırını örmek alalım.

Sadece cst double tanımlanmıştır. b ve csi varyant olarak tanımlanır.

Hepsi double olsun isteniyorsa, Dim b as double, csi as double, cst as double şeklinde yazılmalıdır.

Dim ile değişken tanımlanırken as ile atanmayan her değişken varyanttır.


Erkan Bey size de teşekkür ederim, haklısınız yazılım dili uygun yazımları kullanmadığımız müddetçe kendi ön tanımlanmış verileri işliyor. Aslında bunlar çok basit hatalar ama bir şekilde gözden kaçabiliyor, tamamen hakim olmayışımdan. Teşekkür ederim tekrar.
Kullanıcı avatarı
tdemirhan
Yeni Başlamış
 
Kayıt: 11 Nis 2019 15:43
Meslek: teniker
Yaş: 32
İleti: 61
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Denizli/Merkezefendi


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot, karisma, Yandex[Bot] ve 3 misafir

Bumerang - Yazarkafe