• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Formülleri Birleştir

C

constantinepolisi

Katılım
31 Ocak 2013
Mesajlar
55
Excel Vers. ve Dili
2010 Türkçe
Merhaba,
Aşağıdaki formülleri birleştirmek mümkün mü acaba. Ben araya + koyarak birleştiriyorum değer hatası alıyorum. Acil yardımcı olabilirseniz çok sevinirim.
Kod: 
=EĞER(D3="";"";D3*E3/100)
Kod: 
=EĞER(VE(G3>0;H3>"");(G3*PARÇAAL(H3;1;2)*PARÇAAL(H3;4;2))/15000;"")
 
& işaretini denedinizmi
 
Yaptım oluyor ama iki formülün toplamını tek hücrede ayrı ayrı yazıyor örneğin
İlk formül toplamı 21,4
İkinci formülün toplamı 8,6 varsayalım.
Toplamda 30 yazması gerekirken,
21,48,6 şeklinde yazıyor.
 
Son düzenleme:
Merhaba,
Örnek bir çalışma hazırladımç Gerekli açıklamalarda da bulundum. Bu hataları aci düzenlemem gerekiyor. Yardımcı olabilir misiniz? Arkadaşlar.
 

Ekli dosyalar

Merhaba,

Aşağıdaki formülü denermisiniz.

Kod: 
=EĞER(BAĞ_DEĞ_DOLU_SAY(D3:G3)=0;"";D3*E3/100+EĞER(VE(F3<>0;G3<>0);(F3*PARÇAAL(G3;1;2)*PARÇAAL(G3;4;2))/15000;0))
 
Günaydın Korhan Bey,
Size ne kadar teşekkür etsem azdır. Ne zaman excel hakkında sıkıntı da olsam hemen siz yetişiyorsunuz. Forumda da zaten emeğiniz yeriniz çok büyük.
Her şey için bir kez daha teşekkür ediyorum. Bu formülü kullanacağım farklı sayfalarda mevcut ama orada makroda olması gerekiyor. Rica etsem makroya da çevirebilir misiniz? Makro uygulanacak aralık H3:H
Çok teşekkür ediyorum. İyi çalışmalar dilerim.
Saygılarımla.
 
Aşağıda ki gibi makro kaydet ile yaptım ama hata alıyorum.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
With Range("H3:H" & Son)
.Formula = "=IF(COUNTA(RC[-4]:RC[-1])=0,"""",RC[-4]*RC[-3]/100+IF(AND(RC[-2]<>0,RC[-1]<>0),(RC[-2]*MID(RC[-1],1,2)*MID(RC[-1],4,2))/15000,0))"
 .Value = .Value
 End With
End Sub
 
constantinepolisi' Alıntı:
Aşağıda ki gibi makro kaydet ile yaptım ama hata alıyorum.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
With Range("H3:H" & Son)
.Formula = "=IF(COUNTA(RC[-4]:RC[-1])=0,"""",RC[-4]*RC[-3]/100+IF(AND(RC[-2]<>0,RC[-1]<>0),(RC[-2]*MID(RC[-1],1,2)*MID(RC[-1],4,2))/15000,0))"
 .Value = .Value
 End With
End Sub
Genişletmek için tıkla ...

Yukarıdaki maakroda Son olarak kullandığınızın tanımı yok onun için hata alıyorsunuzdur.
Bu şekilde formülleri makroda kullanmak ileride dosyanın yavaşlamasına sebep olacaktır. Sayfada yaptığınız her harekette formüller milyon satır yenilenecek.
Onun yerine bir modüle uygulayacağınız aşağıdaki gibi bir kod H sutununun hemen yanındaki G sutunu kadar formulunuzu çoğaltır veya siz nekadar olmasını istiyorsanız ona göre değiştirirsiniz.

Kod: 
Sub FormulCogalt ()
Range("H3").Select
    ActiveCell.FormulaR1C1 =  "=IF(COUNTA(RC[-4]:RC[-1])=0,"""",RC[-4]*RC[-3]/100+IF(AND(RC[-2]<>0,RC[-1]<>0),(RC[-2]*MID(RC[-1],1,2)*MID(RC[-1],4,2))/15000,0))"
    Range("H3:H3").AutoFill Destination:=Range("H3:H" & [G65536].End(3).Row), Type:=xlFillDefault

End sub
 
Merhaba Bedri Bey,
Pek yavaşlatacağını sanmıyorum. Siz yine de sayfanın( Private Sub Worksheet_Change(ByVal Target As Range) )olayına yazmış olsaydınız.
Benim için öyle daha önemli sayfada formül olmamalı. O bakımdan Önemli.
Teşekkür ediyorum.
 
Son düzenleme:
constantinepolisi' Alıntı:
Merhaba Bedri bey,
Pek yavaşlatacağını sanmıyorum. Siz yine de sayfanın
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
olayına yazmış olsaydınız.
Benim için öyle daha önemli sayfada formül olmamalı. o bakımdan Önemli.
Teşekkür ediyorum.
Genişletmek için tıkla ...

Pekela o zaman sayfanın kod bölümüne

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
formul
End Sub

bir modül içerisine de

Kod: 
Sub formul()
With Range("H3:H65536")
.Formula = "=IF(COUNTA(RC[-4]:RC[-1])=0,"""",RC[-4]*RC[-3]/100+IF(AND(RC[-2]<>0,RC[-1]<>0),(RC[-2]*MID(RC[-1],1,2)*MID(RC[-1],4,2))/15000,0))"
 .Value = .Value
End With
End Sub
kopyalayıp deneyin

Kolay Gelsin
 
İstediğim yöntem bu şekilde değildi. Sayfaya yani H3:H sütundan aktif hücreye formül uygulaması yapıp gizliyor. Çalışmamda buna benzer formülü makroya çevrilmiş kodlar var ama hiç biri bu kadar yavaş değil.
Korhan Bey,
Siz çevirmiş olsanız nasıl yapardınız. Vaktiniz olduğunda sizin yönteminizi de denemek isterim.
İyi çalışmalar dilerim.
 
Merhaba,

Aşağıdaki gibi kullanabilirsiniz.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D3:G" & Rows.Count)) Is Nothing Then Exit Sub
    On Error Resume Next
    Cells(Target.Row, "H") = "=IF(COUNTA(RC[-4]:RC[-1])=0,"""",RC[-4]*RC[-3]/100+IF(AND(RC[-2]<>0,RC[-1]<>0),(RC[-2]*MID(RC[-1],1,2)*MID(RC[-1],4,2))/15000,0))"
    Cells(Target.Row, "H") = Cells(Target.Row, "H")
End Sub
 
Merhaba günaydın Korhan Bey,
İlginiz için bir kez daha teşekkür ediyorum tam istediğim gibi on numara, elinize bilginize sağlık. Kodları örnek dosyada deniyorum süper çalışıyor. Fakat çalışmamda bu olayla başlayan 2 kod daha var, ilk iki kodun çalışmasında sıkıntı yok. Son eklediğim bu kod çalışmıyor. Yer değişikliği yapıyorum yine sondaki kod çalışmıyor. Nedeni ne olabilir. Kodlar Tamamı aşağıda ki gibidir.

Saygılarımla.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Listeyi gösterir
    Dim Bul As Range, S2 As Worksheet, Adres As String
    If Intersect(Target, Range("A3:A" & Rows.Count, "C3:C" & Rows.Count)) Is Nothing Then Exit Sub
    Cells(Target.Row, "M").Clear
    If Cells(Target.Row, "A") <> "" And Cells(Target.Row, "C") <> "" Then
        Set S2 = Sheets("GÖNDERİLENLER")
        Set Bul = S2.Range("A:A").Find(Cells(Target.Row, "C"), , , xlWhole)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
                If Bul.Offset(0, 5) = Cells(Target.Row, "A") Then
                    With Cells(Target.Row, "M")
                        .Value = "Lİsteye Git"
                        .Font.Bold = True
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .Font.ColorIndex = 1
                    End With
                    Exit Do
                End If
                Set Bul = S2.Range("A:A").FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        End If
    End If
'B sütuna veri yazıldında A sütuna tarihi atar
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
If Target.Row < 3 Then Exit Sub
If Target <> "" Then Target.Offset(0, -1) = Date
'H sütuna sonuçları verir
If Intersect(Target, Range("D3:G" & Rows.Count)) Is Nothing Then Exit Sub
On Error Resume Next
Cells(Target.Row, "H") = "=IF(COUNTA(RC[-4]:RC[-1])=0,"""",RC[-4]*RC[-3]/100+IF(AND(RC[-2]<>0,RC[-1]<>0),(RC[-2]*MID(RC[-1],1,2)*MID(RC[-1],4,2))/15000,0))"
Cells(Target.Row, "H") = Cells(Target.Row, "H")
End Sub
 
Son düzenleme:
Merhaba Korhan Bey,
Günaydın Hayırlı sabahlar,
Yukarıda verdiğim kodlarda ne gibi bir düzeltme yapılması gerekiyor. Vaktiniz olduğunda Bakabilir misinz.
 
Korhan Bey, Bu konuya nasıl bir düzenleme getirebiliriz. Yardımcı olabilir misiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst