Çözüldü Eğer formülünü macro yapma

[cobra26]

Merhaba,

EĞER(F2="PORTAKAL";EĞER(G2="NAKİT";H2*'VERİ '!$R$2;H2*'VERİ '!$R$3);EĞER(F2="ELMA";EĞER(G2="NAKİT";H2*'VERİ '!$S$2;H2*'VERİ '!$S$3);EĞER(F2="HAVUÇ";EĞER(G2="NAKİT";H2*'VERİ '!$T$2;H2*'VERİ '!$T$3);EĞER(F2="DOMATES";EĞER(G2="NAKİT";H2*'VERİ '!$U$2;H2*'VERİ '!$U$3);EĞER(F2="ARMUT";EĞER(G2="NAKİT";H2*'VERİ '!$V$2;H2*'VERİ '!$V$3);EĞER(F2="SALATA";EĞER(G2="NAKİT";H2*'VERİ '!$W$2;H2*'VERİ '!$W$3);EĞER(F2="LİMON";EĞER(G2="NAKİT";H2*'VERİ '!$X$2;H2*'VERİ '!$X$3);EĞER(F2="KİVİ";EĞER(G2="NAKİT";H2*'VERİ '!$Y$2;H2*'VERİ '!$Y$3))))))))) exel dosyamda böyle bir hesaplama formülüm var ve bu formülü 3 ayrı dosyamda kullanıyorum,bu formülü macroyla yapıp tüm dosyalarımı birleştirebilir miyim.?Teşekkür ederim.

 

[Cengizhantr06]

Function Hesapla(Fruit As String, Payment As String, Amount As Double) As Double
    Dim VeriSheet As Worksheet
    Dim Rate As Double

    
    Set VeriSheet = ThisWorkbook.Sheets("VERİ")

    
    Select Case Fruit
        Case "PORTAKAL"
            If Payment = "NAKİT" Then
                Rate = VeriSheet.Range("R2").Value
            Else
                Rate = VeriSheet.Range("R3").Value
            End If
        Case "ELMA"
            If Payment = "NAKİT" Then
                Rate = VeriSheet.Range("S2").Value
            Else
                Rate = VeriSheet.Range("S3").Value
            End If
        Case "HAVUÇ"
            If Payment = "NAKİT" Then
                Rate = VeriSheet.Range("T2").Value
            Else
                Rate = VeriSheet.Range("T3").Value
            End If
        Case "DOMATES"
            If Payment = "NAKİT" Then
                Rate = VeriSheet.Range("U2").Value
            Else
                Rate = VeriSheet.Range("U3").Value
            End If
        Case "ARMUT"
            If Payment = "NAKİT" Then
                Rate = VeriSheet.Range("V2").Value
            Else
                Rate = VeriSheet.Range("V3").Value
            End If
        Case "SALATA"
            If Payment = "NAKİT" Then
                Rate = VeriSheet.Range("W2").Value
            Else
                Rate = VeriSheet.Range("W3").Value
            End If
        Case "LİMON"
            If Payment = "NAKİT" Then
                Rate = VeriSheet.Range("X2").Value
            Else
                Rate = VeriSheet.Range("X3").Value
            End If
        Case "KİVİ"
            If Payment = "NAKİT" Then
                Rate = VeriSheet.Range("Y2").Value
            Else
                Rate = VeriSheet.Range("Y3").Value
            End If
        Case Else
            Hesapla = 0 
            Exit Function
    End Select

    
    Hesapla = Amount * Rate
End Function

Deneyin bakalım

 

[cobra26]

Merhaba Cengizhantr06 hocam çok teşekkür ederim, bir eksikliğim var
Portakal cinsini seçtiğim zaman (nakit ise R2 ile çarpsın ,pos ise R3 ile çarpsın) sonucu (I sütununa )yazsın teşekkür ederim.
Örnek dosya
MEYVE.xlsx - 15 KB

 

[cobra26]

Modülden çalıştıramadım ,alternatif yapabilir misiniz? Teşekkür ederim.

 

[Biolightant]

Portakal cinsini seçtiğim zaman (nakit ise R2 ile çarpsın ,pos ise R3 ile çarpsın) sonucu (I sütununa )yazsın teşekkür ederim.

Örnek dosyanızla söyledikleriniz Uyuşmuyor.

Örnek dosyanızda Gizli sütunları açınca gözüken.
Ürün Portakal Satış Nakitse Miktar * H1 le çarpılması gerekir
Ürün Portakal Satış Possa Miktar * H2 le çarpılması gerekir
Sonuçta F sütununa (F5 den itibaren aşağıya) yazılıyor.

Örnek dosyanın güncel halini yükleyebilir misiniz.

 

[cobra26]

Merhaba Biolightant Bey çok teşekkür ederim, örnek dosyamın güncel halini yükledim
Ürün Portakal Satış Nakitse Miktar * H2 le çarpılması gerekir
Ürün Portakal Satış Possa Miktar * H3 le çarpılması gerekir
Sonuçta F sütununa (F5 den itibaren aşağıya) yazılıyor.

Formülde sıkıntı yok çalışıyor, fakat böyle 3 tane Excel dosyam var ve Bilgisayarımı çok kasıyor, ve bunları tek dosyada birleştirmek istiyorum, yıllık binlerce satır var, ama macro ile yapmak istiyorum.Cengizhantr06 sağ olsun Cengiz hocam kodları vermiş ama bir türlü çalıştıramadım.

Teşekkür ederim.

İndir MEYVE

Dosyayı indir MEYVE

dosya.co

 

[Muzaffer Ali]

Merhaba.
Dosyanız ekte inceleyiniz.

MEYVE.xlsm dosyasını indir - download

MEYVE.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[cobra26]

Muzaffer Ali Bey büyük dertten kurtardınız, sayenizde bütün Excel dosyalarımı birleştirebilirim. Çok ama çok teşekkür ederim.