Belirli kodlara göre dağıtım

[unutkan518]

Merhaba

Ekli dosya yapmak istediklerimi yazmaya çalıştım. Formülle 1 kodun dağıtımı yaptım fakat diğerlerini dağıtmayı yapamadım.
İlgili dağıtımı vba ile yapmak için yardım edebilir misiniz. https://drive.google.com/file/d/1jrxO-vIyF1ljXJwh1s4x2leTohWvFjec/view?usp=sharing

 

[unutkan518]

Merhaba

Ekli dosya yapmak istediklerimi yazmaya çalıştım. Formülle 1 kodun dağıtımı yaptım fakat diğerlerini dağıtmayı yapamadım.
İlgili dağıtımı vba ile yapmak için yardım edebilir misiniz.

Google Drive: Sign-in

Access Google Drive with a Google account (for personal use) or Google Workspace account (for business use).

drive.google.com

Google Drive: Sign-in

Access Google Drive with a Google account (for personal use) or Google Workspace account (for business use).

drive.google.com

 

[Ömer]

Merhaba,

Dosyanızı aşağıdaki linke ekler misiniz.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz.

dosya.co

 

[unutkan518]

İndir örnek

Dosyayı indir örnek

dosya.co

ekledim

 

[unutkan518]

Merhaba,

Dosyanızı aşağıdaki linke ekler misiniz.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz.

dosya.co

Merhaba

Dosyayı eklemiştim. Konu ile ilgili çözüm öneriniz varmıdır acaba.

 

[Ömer]

Sorunuz anlaşılmıyor. Yada ben anlamadım.

C2 hücresine yazıp alt satırlara kopyalayın. İstediğiniz bu mu?

=B2/DÜŞEYARA(A2;$H$2:$K$13;4;0)*DÜŞEYARA(A2;$H$2:$K$13;2;0)

 

[unutkan518]

Sorunuz anlaşılmıyor. Yada ben anlamadım.

C2 hücresine yazıp alt satırlara kopyalayın. İstediğiniz bu mu?

=B2/DÜŞEYARA(A2;$H$2:$K$13;4;0)*DÜŞEYARA(A2;$H$2:$K$13;2;0)

Merhaba

Yapmak istediğim formülle yaptığınız işlemi vba ile yapmak aslında. Teşekkürler yanıt için

 

[Ömer]

Kodları çalıştırmadan önce, tablonun alt bölümünde A sütuna yazdığınız açıklamaları silersiniz.

Sub ek_gelen_tutar()

    Dim i As Long, c As Range
    
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Set c = [H:H].Find(Cells(i, "A"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Cells(i, "C") = Cells(i, "B") / Cells(c.Row, "K") * Cells(c.Row, "I")
        End If
    Next i
    
End Sub

 

[unutkan518]

Kodları çalıştırmadan önce, tablonun alt bölümünde A sütuna yazdığınız açıklamaları silersiniz.

Sub ek_gelen_tutar()

    Dim i As Long, c As Range
   
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Set c = [H:H].Find(Cells(i, "A"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Cells(i, "C") = Cells(i, "B") / Cells(c.Row, "K") * Cells(c.Row, "I")
        End If
    Next i
   
End Sub

Ömer bey

Bu kodlarla dağıtım yaptım çalışıyor
yardımınız için çok teşekkür ederim. İyi Çalışmalar