Soru Hata Düzeltme

[selus]

Merhabalar,
Yapmış olduğum tabloda kullanıcı tarafından seçilen iki firmanın ürün kodlarına ait fiyatların oranını almak ve bunu sonuç kısmına yazdırmak istiyorum. Kodu aşağıdaki gibi yazdım. Fakat
]Set firma1 = Columns("D:H").Find(what:=Cells(1, 4).Value, LookIn:=xlValues) Set firma2 = Columns("D:H").Find(what:=Cells(1, 6).Value, LookIn:=xlValues) 'da cells(1,4) ve cells(1,6) yazdığım için sadece o sütunların hesabını yapıyor. Yeni olduğum için ne yapabileceğimin mantığını kurmakta zorlandım. Ayrıca firmalar arttırıldığında yani yeni bir sütun eklemek istediğimizde ne yapabilirim. Yardımcı olursanız sevinirim.

Sub deneme()
Dim i As Integer
Dim firma1 As Range
Dim firma2 As Range


For i = 4 To Cells(Rows.Count, "B").End(xlUp).Row
    Set firma1 = Columns("D:H").Find(what:=Cells(1, 4).Value, LookIn:=xlValues)
    Set firma2 = Columns("D:H").Find(what:=Cells(1, 6).Value, LookIn:=xlValues)
    
    If Not firma1 Is Nothing And Not firma2 Is Nothing Then
    Cells(i, 9).Value = Cells(i, firma1.Column).Value / Cells(i, firma2.Column).Value
    End If
Next i

End Sub

 

[Muzaffer Ali]

Merhaba.
Dosyanız ekte deneyiniz.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Sub deneme()
Dim i As Integer
Dim firma1 As Integer
Dim firma2 As Integer

Application.Calculation = xlCalculationManual

firma1 = WorksheetFunction.Match(Range("D1"), Range("3:3"), 0)
firma2 = WorksheetFunction.Match(Range("F1"), Range("3:3"), 0)
sonsut = Cells(3, Columns.Count).End(xlToLeft).Column

For i = 4 To Cells(Rows.Count, "D").End(xlUp).Row
If Val(Cells(i, firma1)) = 0 Or Val(Cells(i, firma2)) = 0 Then GoTo 10
Cells(i, sonsut) = Cells(i, firma1) / Cells(i, firma2)
10 Next i

Application.Calculation = xlCalculationAutomatic

End Sub

 

[selus]

Merhabalar, öncelikle teşekkür ederim. İki kodu da denedim istediğim gibi çalışıyor fakat H sütununa E firmasını eklediğimde sonuçları yine I sütununa yazdırıyor. Yani yeni firma eklediğimde sonucu yazdıracağım sütunu her seferinde nasıl kaydırabilirim?

 

[Levent Menteşoğlu]

Yukarıdaki cevabımda bir düzeltme yaptım. Tekrar deneyin.