Hücre Değeri Değişince Makro Çalışması ve Sonsuz Döngü Sorunu

Cevapla
ToHaNS
Mesajlar: 2
Kayıt: Pzr Eyl 15, 2024 9:03 am
Lokasyon: Ankara
Adınız: Tolga Hasan
Soyadınız: Sagturk

Hücre Değeri Değişince Makro Çalışması ve Sonsuz Döngü Sorunu

Mesaj gönderen ToHaNS »

Kıymetli hocalarım merhaba, Office 365 TR kullanıyorum.

Başlıkta da belirttiğim gibi, bir tabloda hücrenin içeriği değiştiğinde verilerde dönüşüm ve güncelleme yapmaya çalışıyorum. Yazılı olan kodları forumdaki benzer eski konuları inceleyerek kendime göre uyarlamaya çalıştım fakat, sanıyorum bir çok hücrede işlem yapmak istediğim için sonsuz döngüye giriyor ve excel kapatılıyor.

Tablomun B1 sütununda USD/CAD paritesi D1 sütununda ise CAD/USD paritesi bulunmakta.

B kolonuna bir rakamsal değer girdiğimde C kolonunda CAD karşılığını,
C kolonuna bir rakamsal değer girdiğimde B kolonunda USD karşılığını yazdırmaya çalıştım.

Bu para birimlerinin dönüşüm işlemini; B ile C sütunları kendi arasında, E ile F sütunları kendi arasında, G ile H, I ile J, K ile L, M ile N, O ile P sütunları kendi aralarında şeklinde ilerliyor. (Örnek dosyada sanırım daha iyi anlaşılacaktır diye ümit ediyorum) Ayrıca bu dönüşümlerin sonrasında da bir takım matematiksel hesaplamalar yaptırıyorum. Bu matematiksel hesaplamalar, aynı şekilde birbirini tekrar eden hesaplamalar.

Bahse konu bu hesaplamaları B:N aralığında hangi sütunda değişiklik yaparsam ilgili satırda hesaplama yapmasını hedefledim bunun için de ayrı bir makro ismiyle yazıp her satırda yeniden yazmak yerine "Call makroAdi" şeklinde çağırmaya çalıştım ama onu da başaramadım.

Bir diğer yapmak istediğim ise, Eğer B ve C sütunlarının değeri boşsa, Cells(satir, "E:F" & "O:X") içeriğinin silinmesini hedefledim fakat yapamadım, yine sonsuz döngü etkisinde kaldım sanıyorum.

Buraya yazmadan önce gerçekten çok fazla uğraştım ve denedim aklıma gelen yöntemleri ama başaramadım. Desteklerinizi rica ediyorum.

Kod: Tümünü seç

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("B3:B10000")) Is Nothing Then
        sat = Target.Row
        If Cells(sat, "C") = Cells(sat, "B") * Range("B1") Then Exit Sub                                'Sonsuz döngüye girmemesi için yazdım
            If Cells(sat, "D") = "" Then Cells(sat, "D") = 1
            Cells(sat, "C") = Cells(sat, "B") * Range("B1")                                             'C Sütünunu CAD dönüştür
            
            'Buradan sonrası ortak işlemler
            Cells(sat, "E") = Cells(sat, "B") * Cells(sat, "D")                                         'E Sütununu Toplam dolar maliyetini yaz
            Cells(sat, "F") = Cells(sat, "E") * Range("B1")                                             'E Sütununu Kanada dolarına Çevir F sütununa yaz
            Cells(sat, "Q") = Cells(sat, "E") + Cells(sat, "K") + Cells(sat, "M")                       ' Q Sütununa Toplam USD maliyetini hesapla
            Cells(sat, "R") = Cells(sat, "Q") * Range("B1")                                             ' R Sütununa Toplam CAD maliyetine dönüştür
            Cells(sat, "O") = Cells(sat, "Q") / Cells(sat, "D")                                         ' O Sütununa Birim başına USD maliyetini hesapla (Toplam MAliyeti Adede böl
            Cells(sat, "P") = Cells(sat, "O") * Range("B1")                                             ' P Sütununa Birim başına CAD maliyetine dönüştür
            Cells(sat, "S") = Cells(sat, "G") - Cells(sat, "O") - Cells(sat, "I")                       ' S Sütununa Birim başına USD Marj tutarını hesapla
            Cells(sat, "T") = Cells(sat, "S") * Range("B1")                                             ' T Sütununa Birim başına CAD Marj tutarına dönüştür
            Cells(sat, "U") = Cells(sat, "S") * Cells(sat, "D")                                         ' S Sütununa Toplam USD Tahmini Marjını hesapla (Br. Marjı x Adet)
            Cells(sat, "V") = Cells(sat, "U") * Range("B1")                                             ' U Sütununa Toplam CAD Tahmini Marjına dönüştür
            Cells(sat, "W") = Cells(sat, "S") / Cells(sat, "G")                                         ' Marj rakamlarının yüzdelik oranlarını dönüştür
            Cells(sat, "X") = Cells(sat, "S") / Cells(sat, "O")                                         ' ROI hesapla
            Exit Sub
    Else
    If Not Intersect(Target, Range("C3:C10000")) Is Nothing Then
        sat = Target.Row
        If Cells(sat, "B") = Cells(sat, "C") * Range("D1") Then Exit Sub                                'Sonsuz Döngüye girmemesi için yazdım
            If Cells(sat, "D") = "" Then Cells(sat, "D") = 1
            Cells(sat, "B") = Cells(sat, "C") * Range("D1")                                             'B Sütünunu USD dönüştür
            
            'Buradan sonrası ortak işlemler
            Cells(sat, "E") = Cells(sat, "B") * Cells(sat, "D")                                         'E Sütununu Toplam dolar maliyetini yaz
            Cells(sat, "F") = Cells(sat, "E") * Range("B1")                                             'E Sütununu Kanada dolarına Çevir F sütununa yaz
            Cells(sat, "Q") = Cells(sat, "E") + Cells(sat, "K") + Cells(sat, "M")                       ' Q Sütununa Toplam USD maliyetini hesapla
            Cells(sat, "R") = Cells(sat, "Q") * Range("B1")                                             ' R Sütununa Toplam CAD maliyetine dönüştür
            Cells(sat, "O") = Cells(sat, "Q") / Cells(sat, "D")                                         ' O Sütununa Birim başına USD maliyetini hesapla (Toplam MAliyeti Adede böl
            Cells(sat, "P") = Cells(sat, "O") * Range("B1")                                             ' P Sütununa Birim başına CAD maliyetine dönüştür
            Cells(sat, "S") = Cells(sat, "G") - Cells(sat, "O") - Cells(sat, "I")                       ' S Sütununa Birim başına USD Marj tutarını hesapla
            Cells(sat, "T") = Cells(sat, "S") * Range("B1")                                             ' T Sütununa Birim başına CAD Marj tutarına dönüştür
            Cells(sat, "U") = Cells(sat, "S") * Cells(sat, "D")                                         ' S Sütununa Toplam USD Tahmini Marjını hesapla (Br. Marjı x Adet)
            Cells(sat, "V") = Cells(sat, "U") * Range("B1")                                             ' U Sütununa Toplam CAD Tahmini Marjına dönüştür
            Cells(sat, "W") = Cells(sat, "S") / Cells(sat, "G")                                         ' Marj rakamlarının yüzdelik oranlarını dönüştür
            Cells(sat, "X") = Cells(sat, "S") / Cells(sat, "O")                                         ' ROI hesapla
            Exit Sub
    Else
    If Not Intersect(Target, Range("E3:E10000")) Is Nothing Then
        sat = Target.Row
        If Cells(sat, "F") = Cells(sat, "E") * Range("B1") Then Exit Sub                                'Sonsuz döngüye girmemesi için yazdım
            If Cells(sat, "D") = "" Then Cells(sat, "D") = 1
            Cells(sat, "F") = Cells(sat, "E") * Range("B1")                                             'F Sütünunu CAD dönüştür
            
            'Buradan sonrası ortak işlemler
            Cells(sat, "E") = Cells(sat, "B") * Cells(sat, "D")                                         'E Sütununu Toplam dolar maliyetini yaz
            Cells(sat, "F") = Cells(sat, "E") * Range("B1")                                             'E Sütununu Kanada dolarına Çevir F sütununa yaz
            Cells(sat, "Q") = Cells(sat, "E") + Cells(sat, "K") + Cells(sat, "M")                       ' Q Sütununa Toplam USD maliyetini hesapla
            Cells(sat, "R") = Cells(sat, "Q") * Range("B1")                                             ' R Sütununa Toplam CAD maliyetine dönüştür
            Cells(sat, "O") = Cells(sat, "Q") / Cells(sat, "D")                                         ' O Sütununa Birim başına USD maliyetini hesapla (Toplam MAliyeti Adede böl
            Cells(sat, "P") = Cells(sat, "O") * Range("B1")                                             ' P Sütununa Birim başına CAD maliyetine dönüştür
            Cells(sat, "S") = Cells(sat, "G") - Cells(sat, "O") - Cells(sat, "I")                       ' S Sütununa Birim başına USD Marj tutarını hesapla
            Cells(sat, "T") = Cells(sat, "S") * Range("B1")                                             ' T Sütununa Birim başına CAD Marj tutarına dönüştür
            Cells(sat, "U") = Cells(sat, "S") * Cells(sat, "D")                                         ' S Sütununa Toplam USD Tahmini Marjını hesapla (Br. Marjı x Adet)
            Cells(sat, "V") = Cells(sat, "U") * Range("B1")                                             ' U Sütununa Toplam CAD Tahmini Marjına dönüştür
            Cells(sat, "W") = Cells(sat, "S") / Cells(sat, "G")                                         ' Marj rakamlarının yüzdelik oranlarını dönüştür
            Cells(sat, "X") = Cells(sat, "S") / Cells(sat, "O")                                         ' ROI hesapla
    Else
    If Not Intersect(Target, Range("F3:F10000")) Is Nothing Then
        sat = Target.Row
        If Cells(sat, "E") = Cells(sat, "F") * Range("D1") Then Exit Sub                                'Sonsuz döngüye girmemesi için yazdım
            If Cells(sat, "D") = "" Then Cells(sat, "D") = 1
            Cells(sat, "E") = Cells(sat, "F") * Range("D1")                                             'E Sütünunu USD dönüştür
            
            'Buradan sonrası ortak işlemler
            Cells(sat, "E") = Cells(sat, "B") * Cells(sat, "D")                                         'E Sütununu Toplam dolar maliyetini yaz
            Cells(sat, "F") = Cells(sat, "E") * Range("B1")                                             'E Sütununu Kanada dolarına Çevir F sütununa yaz
            Cells(sat, "Q") = Cells(sat, "E") + Cells(sat, "K") + Cells(sat, "M")                       ' Q Sütununa Toplam USD maliyetini hesapla
            Cells(sat, "R") = Cells(sat, "Q") * Range("B1")                                             ' R Sütununa Toplam CAD maliyetine dönüştür
            Cells(sat, "O") = Cells(sat, "Q") / Cells(sat, "D")                                         ' O Sütununa Birim başına USD maliyetini hesapla (Toplam MAliyeti Adede böl
            Cells(sat, "P") = Cells(sat, "O") * Range("B1")                                             ' P Sütununa Birim başına CAD maliyetine dönüştür
            Cells(sat, "S") = Cells(sat, "G") - Cells(sat, "O") - Cells(sat, "I")                       ' S Sütununa Birim başına USD Marj tutarını hesapla
            Cells(sat, "T") = Cells(sat, "S") * Range("B1")                                             ' T Sütununa Birim başına CAD Marj tutarına dönüştür
            Cells(sat, "U") = Cells(sat, "S") * Cells(sat, "D")                                         ' S Sütununa Toplam USD Tahmini Marjını hesapla (Br. Marjı x Adet)
            Cells(sat, "V") = Cells(sat, "U") * Range("B1")                                             ' U Sütununa Toplam CAD Tahmini Marjına dönüştür
            Cells(sat, "W") = Cells(sat, "S") / Cells(sat, "G")                                         ' Marj rakamlarının yüzdelik oranlarını dönüştür
            Cells(sat, "X") = Cells(sat, "S") / Cells(sat, "O")                                         ' ROI hesapla
    End If
    End If
    End If
    End If
End Sub
Liste.xlsm
Bu mesaja eklenen dosyaları görüntülemek için gerekli izinlere sahip değilsiniz.
ToHaNS
Mesajlar: 2
Kayıt: Pzr Eyl 15, 2024 9:03 am
Lokasyon: Ankara
Adınız: Tolga Hasan
Soyadınız: Sagturk

Re: Hücre Değeri Değişince Makro Çalışması ve Sonsuz Döngü Sorunu

Mesaj gönderen ToHaNS »

Kod: Tümünü seç

Application.EnableEvents = False

Kod: Tümünü seç

Application.EnableEvents = True
Bu kodlar ile excel'in kendini kapatması sorununu çözdüm ve kodları yeniden düzenledim.
Cevapla
  • Benzer Konular
    Cevaplar
    Görüntüleme
    Son mesaj