ferhat pazarcevirdi bey den aldıgım kodu calıstıramadım

[uguristanbul]

kdv hesaplama ile ilgili bu kodu kendime uyarlayamadım

degerli arkadaslarım
ekli dosyada klasik bir ön muhasebe programı calısması bulunmakta
veri sayfasındaki butona tıklayın ve acılacak formda "cari işlemler "combosundan fatura bölümünü tıklayın
2 nci bir form acılacak acılan 2nci formda ürün bilgilerinizi giriniz frame inde ekle butonuna (sn:ferhat pazarcevirdiden aldıgım) şu kodu kopyaladım
Dim col As New Collection
Dim arrV()
Dim i As Integer
Dim x As Integer
Dim j As Integer
On Error Resume Next
For i = 2 To Cells(65536, "N").End(xlUp).Row
'KDV oranları koleksiyona alınıyor
col.Add CStr(Cells(i, "N")), CStr(Cells(i, "N"))
'Eğer hata değeri alınmamışsa
'Benzersiz veriler, ilk defa diziye alınıyor
If Err.Number = 0 Then
x = x + 1
ReDim Preserve arrV(1 To 4, 1 To x)
arrV(1, x) = Cells(i, "N")
arrV(2, x) = Cells(i, "S")
arrV(3, x) = Cells(i, "N") * Cells(i, "S") / 100
arrV(4, 1) = arrV(3, x) + arrV(4, 1)
'Bir hata ile kaşılaşılmışsa,
'bu veri daha önce koleksiyonda ve dolayısıyla dizide vardır
'Onun için dizide ilgili eleman bulunup
'karşısındaki değer güncelleniyor
Else
For j = 1 To UBound(arrV, 2)
If Cells(i, "N") = arrV(1, j) Then
arrV(2, j) = arrV(2, j) + Cells(i, "S")
arrV(3, j) = arrV(3, j) + (Cells(i, "S") * arrV(1, j) / 100)
arrV(4, 1) = arrV(4, 1) + arrV(3, j)
Exit For
End If
Next j
'Hata değeri, yeni değerlendirme için sıfırlanıyor
End If
Next i
On Error GoTo 0
'Derlenen verilerin yazdırılacağı alan temizleniyor
Range("A2" & Cells(65536, 1).End(xlUp).Row).ClearContents
'Veriler sayfaya yazdırılıyor
Range("A2").Resize(UBound(arrV, 2), _
UBound(arrV, 1)) = Application.WorksheetFunction.Transpose(arrV)
End If
End Sub
(dosyayı incelediginizde goreceksiniz)
ancak bu kod farklı kdv oranlarını dogru hesaplarken
benzer kdv oranlarında hata yapıyor(ekle butonun ustunde birde aktarma kodu bulunmakta) ve ekledigin anda hesaplama yapmıyor (kdv hesabı list box 1de dir ve kdv hesaplaması icin checkbox3 ün =true olması gerekir)illa checkbox 3 cliklemem gerekiyor
nasıl duzeltmem gerekir
yardımlarınız icin teskkur eder
saygılar sunarım

 

[zafer]

Merhaba

Lütfen konu başlığınızı değiştiriniz.