İç içe Döngü Sorunu

[unfors]

Hazırladığım formda Firma adına göre İskonto Listesinden iskonto uygulamak istiyorum. Sorun sıralı bir şekilde uyguluyor. Liste ve Firmanın sırası değişince sonuç vermiyor.
Dosya Linki: http://dosya.co/9s027akd69ak/MALIYET.rar.html

 

[unfors]

On Error Resume Next

For j = 0 To ListBox2.ListCount - 1

rte = ThisWorkbook.Path & "\HAMMADDE.xlsx"
Dim con As Object, rs As Object, Sorgu As String
Set con = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.RecordSet")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & rte & ";" & "Extended Properties=""Excel 12.0;HDR=No"";"

Sorgu = "Select * from [HAMMADDE$] where f1 ='" & ListBox2.Column(0, j) & "'"
rs.Open Sorgu, con, 1, 3

ListBox2.Column(1, j) = rs.Fields(1).Value
ListBox2.Column(2, j) = rs.Fields(2).Value
ListBox2.Column(3, j) = rs.Fields(3).Value

i = 0
If rs.Fields(3).Value = iskonto.ListBox1.Column(0, i) Then
x1 = iskonto.ListBox1.Column(1, i)
x2 = iskonto.ListBox1.Column(2, i)
x3 = iskonto.ListBox1.Column(3, i)
x4 = iskonto.ListBox1.Column(4, i)
Else
x1 = "0"
x2 = "0"
x3 = "0"
x4 = "0"
End If

If rs.Fields(9).Value <> "" Then
ListBox2.Column(7, j) = Format(rs.Fields(9).Value * EURO.Value _
* (1 - val(x1) / 100) * (1 - val(x2) / 100) * (1 - val(x3) / 100) * (1 - val(x4) / 100), "currency")

ElseIf rs.Fields(8).Value <> "" Then
ListBox2.Column(7, j) = Format(rs.Fields(8).Value * DOLAR.Value _
* (1 - val(x1) / 100) * (1 - val(x2) / 100) * (1 - val(x3) / 100) * (1 - val(x4) / 100), "currency")

ElseIf rs.Fields(7).Value <> "" Then
ListBox2.Column(7, j) = Format(rs.Fields(7).Value * (1 - val(x1) / 100) * (1 - val(x2) / 100) _
* (1 - val(x3) / 100) * (1 - val(x4) / 100), "currency")
End If

i = i + 1

rs.Close: con.Close
Set con = Nothing: Set rs = Nothing: Sorgu = ""

Next

iskonto kayıtlarının olduğu listbox'dan aldığım veriler Listbox2'de sıralı olarak uygulanıyor. Malzeme listesinde firma ilk hangisi varsa onu buluyor diğerini atlıyor.

 

[unfors]

On Error Resume Next

For j = 0 To ListBox2.ListCount - 1

rte = ThisWorkbook.Path & "\HAMMADDE.xlsx"
Dim con As Object, rs As Object, Sorgu As String
Set con = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.RecordSet")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & rte & ";" & "Extended Properties=""Excel 12.0;HDR=No"";"

Sorgu = "Select * from [HAMMADDE$] where f1 ='" & ListBox2.Column(0, j) & "'"
rs.Open Sorgu, con, 1, 3

ListBox2.Column(1, j) = rs.Fields(1).Value
ListBox2.Column(2, j) = rs.Fields(2).Value
ListBox2.Column(3, j) = rs.Fields(3).Value

If rs.Fields(9).Value <> "" Then
ListBox2.Column(7, j) = Format(rs.Fields(9).Value * EURO.Value, "currency")
ElseIf rs.Fields(8).Value <> "" Then
ListBox2.Column(7, j) = Format(rs.Fields(8).Value * DOLAR.Value, "currency")
ElseIf rs.Fields(7).Value <> "" Then
ListBox2.Column(7, j) = Format(rs.Fields(7).Value, "currency")
End If

For z = 0 To iskonto.ListBox1.ListCount - 1
If ListBox2.Column(3, j) = iskonto.ListBox1.Column(0, z) Then
x1 = iskonto.ListBox1.Column(1, z)
x2 = iskonto.ListBox1.Column(2, z)
x3 = iskonto.ListBox1.Column(3, z)
x4 = iskonto.ListBox1.Column(4, z)

ListBox2.Column(7, j) = Format(ListBox2.Column(7, j) * (1 - val(x1) / 100) * (1 - val(x2) / 100) * (1 - val(x3) / 100) * (1 - val(x4) / 100), "currency")
ListBox2.Column(12, j) = x1 & "  " & x2 & "  " & x3 & "  " & x4

z = z + 1
Else
End If

rs.Close: con.Close
Set con = Nothing: Set rs = Nothing: Sorgu = ""

Next
Next

Bu şekilde düzenleyince sorun çözülmüştür