Topla çarpım kodu hakkında

[Zafer Konuk]

İyi günler dilerim. Daha önceden 32 bitte kullanmış olduğum topla çarpım kodu 64 bitte hata veriyor. Bu konu hakkında yardımcı olabilir misiniz?

Private Sub CommandButton296_Click()
If MsgBox("İcmal Toplamı Almak İstiyor Musunuz? ?", vbYesNo, "Dikkat") = vbNo Then Exit Sub

MsgBox "Lütfen Bekleyiniz.....Verileriniz Hesaplanıyor...", vbCritical
Sheets("İCMAL").Select
Dim con As Object, rs As Object
Set con = CreateObject("ADODB.Connection")
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=YES"""
Range("N2:P65536").ClearContents

For i = 2 To Sheets("İCMAL").Range("B65536").End(3).Row

Set rs = CreateObject("ADODB.recordset")
sorgu = "SELECT SUM([ADET]),SUM([HACİM]),SUM([STER]) FROM [ÇIKIŞ$] Where [YILI]=" & Sheets("İCMAL").Cells(i, 10) & " AND [İSTİF]=" & Sheets("İCMAL").Cells(i, 2) & "'"

rs.Open sorgu, con, 1, 3
Range("N" & i).CopyFromRecordset rs
Range("O" & i).CopyFromRecordset rs
Range("P" & i).CopyFromRecordset rs
Next i
rs.Close
Set con = Nothing
Set rs = Nothing: sorgu = ""
MsgBox " Hesaplama Yapılmıştır. ", vbInformation

End Sub

[SNNAY]

BU kodları dener misiniz.

Kod: Tümünü seç

Private Sub CommandButton296_Click()
    If MsgBox("İcmal Toplamı Almak İstiyor Musunuz? ?", vbYesNo, "Dikkat") = vbNo Then Exit Sub

    MsgBox "Lütfen Bekleyiniz.....Verileriniz Hesaplanıyor...", vbCritical
    Sheets("İCMAL").Select
    Dim con As Object, rs As Object
    Set con = CreateObject("ADODB.Connection")
    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"""
    Range("N2:P65536").ClearContents

    For i = 2 To Sheets("İCMAL").Range("B65536").End(xlUp).Row
        Set rs = CreateObject("ADODB.Recordset")
        sorgu = "SELECT SUM([ADET]),SUM([HACİM]),SUM([STER]) FROM [ÇIKIŞ$] Where [YILI]=" & Sheets("İCMAL").Cells(i, 10) & " AND [İSTİF]=" & Sheets("İCMAL").Cells(i, 2)

        rs.Open sorgu, con, 1, 3
        Sheets("İCMAL").Cells(i, 14).CopyFromRecordset rs
        Sheets("İCMAL").Cells(i, 15).CopyFromRecordset rs
        Sheets("İCMAL").Cells(i, 16).CopyFromRecordset rs
        rs.Close
    Next i

    Set con = Nothing
    Set rs = Nothing
    sorgu = ""
    MsgBox " Hesaplama Yapılmıştır. ", vbInformation
End Sub

[Zafer Konuk]

Sinan Bey alakanız için teşekkür ederim. Fakat; rs.Open sorgu, con, 1, 3 hatası veriyor. Sebebi ne olabilir?

[SNNAY]

Birden fazla sebebi olabilir;
Boş veya Hatalı SQL Sorgusu, Veri tabanı Bağlantısı veya Dosya Adı, Veri Türü Uyumsuzluğu veya ADODB Bağlantı Problemi olabilir. Bağlantı parametresini değiştirerek tekrar dener misiniz. Ayrıva YILI ve İSTİF sütunlarında ki veriler sayısal çift tırnakları kaldırınız .

Kod: Tümünü seç

Private Sub CommandButton296_Click()
    If MsgBox("İcmal Toplamı Almak İstiyor Musunuz? ?", vbYesNo, "Dikkat") = vbNo Then Exit Sub

    MsgBox "Lütfen Bekleyiniz.....Verileriniz Hesaplanıyor...", vbCritical
    Sheets("İCMAL").Select
    Dim con As Object, rs As Object
    Set con = CreateObject("ADODB.Connection")
    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"""
    Range("N2:P65536").ClearContents

    For i = 2 To Sheets("İCMAL").Range("B65536").End(xlUp).Row
        Set rs = CreateObject("ADODB.Recordset")
        Dim yil As String
        Dim istif As String
        yil = Sheets("İCMAL").Cells(i, 10).Value
        istif = Sheets("İCMAL").Cells(i, 2).Value
        sorgu = "SELECT SUM([ADET]), SUM([HACİM]), SUM([STER]) FROM [ÇIKIŞ$] WHERE [YILI] = '" & yil & "' AND [İSTİF] = '" & istif & "'"

        rs.Open sorgu, con, 1, 2  'daha önce 3 ile çalışmadı eğer 2 çalışırsa bağlantı hatası..
        If Not rs.EOF Then
            Sheets("İCMAL").Cells(i, 14).Value = rs.Fields(0).Value
            Sheets("İCMAL").Cells(i, 15).Value = rs.Fields(1).Value
            Sheets("İCMAL").Cells(i, 16).Value = rs.Fields(2).Value
        End If
        rs.Close
    Next i

    con.Close
    Set con = Nothing
    Set rs = Nothing
    sorgu = ""
    MsgBox "Hesaplama Yapılmıştır.", vbInformation
End Sub

[Zafer Konuk]

Sinan Bey alakanız için teşekkür ederim. Ellerinize sağlık.