ALT ALTA SIRALI (2 SÜTUN) RAKAMLARI TEK BİR HÜCREYE YAZDIRMA HK.

[td877]

Merhaba,

2 sütunum var rakamların olduğu, bu rakamları oluşmasını istediğim formül şeklinde aynı hücreye yanyana yazdırabilir miyim?

İlk satırdaki rakamla, ikinci satırı çarpacak sonra + diyecek. Alt satırla devam edecek bir döngü.

Yardımlarınız için şimdiden teşekkür ediyorum örnek dosyayı aşağı ekliyorum.

https://s2.dosya.tc/server10/g8z3up/RAKAMLARI_TEK_HUCREYE_YAZDIRMA__ORNEK_.xlsx.html

 

[Muzaffer Ali]

Merhaba şu kod ile yapabilirsiniz.

Sub Test()
    Dim Bak As Range
    Dim i As String
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        i = i & Bak & "*" & Bak(1, 2) & "+"
    Next
    i = Left(i, Len(i) - 1)
    i = "=+(" & i & ")"
    Range("D3").Formula = i
End Sub

 

[td877]

Merhaba şu kod ile yapabilirsiniz.

Sub Test()
    Dim Bak As Range
    Dim i As String
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        i = i & Bak & "*" & Bak(1, 2) & "+"
    Next
    i = Left(i, Len(i) - 1)
    i = "=+(" & i & ")"
    Range("D3").Formula = i
End Sub

Merhaba, kod tam istediğim gibi çalışıyor çok teşekkür ederim yardımlarınız için.

 

[td877]

İlaveten bişey sorabilir miyim, misal "0" rakamını almak istemiyorum, bunu nasıl ekleyebiliriz?

 

[Muzaffer Ali]

Olasılık hakkında bir şey söylememişsiniz. Her olasılığa göre kodlar aşağıdadır.

Sub Test1()
    Dim Bak As Range
    Dim i As String
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        If Not Bak = 0 Then 'SAdece A sütunu 0 sıfırsa ekleme
            i = i & Bak & "*" & Bak(1, 2) & "+"
        End If
    Next
    i = Left(i, Len(i) - 1)
    i = "=+(" & i & ")"
    Range("D1").Formula = i
End Sub
Sub Test2()
    Dim Bak As Range
    Dim i As String
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        If Not Bak(1, 2) = 0 Then 'SAdece B sütunu 0 sıfırsa ekleme
            i = i & Bak & "*" & Bak(1, 2) & "+"
        End If
    Next
    i = Left(i, Len(i) - 1)
    i = "=+(" & i & ")"
    Range("D2").Formula = i
End Sub
Sub Test3()
    Dim Bak As Range
    Dim i As String
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        If Not Bak = 0 Or Not Bak(1, 2) = 0 Then 'A ve B sütunlarının ikiside 0 sıfırsa ekleme
            i = i & Bak & "*" & Bak(1, 2) & "+"
        End If
    Next
    i = Left(i, Len(i) - 1)
    i = "=+(" & i & ")"
    Range("D3").Formula = i
End Sub
Sub Test4()
    Dim Bak As Range
    Dim i As String
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        If Not Bak = 0 And Not Bak(1, 2) = 0 Then 'A yada B sütunlarından herhangi biri 0 sıfırsa ekleme
            i = i & Bak & "*" & Bak(1, 2) & "+"
        End If
    Next
    i = Left(i, Len(i) - 1)
    i = "=+(" & i & ")"
    Range("D4").Formula = i
End Sub

 

[td877]

Merhaba,

Kusura bakmayın sizin kadar hakim olmadığım için olasılık söz konusu olduğunu düşünemedim. Benim hatamdı.
"A yada B sütunlarından herhangi biri 0 sıfırsa ekleme" olasılığı idi bahsettiğim, çok teşekkür ederim bu işinden altından kalkmışsınız.

Vallahi ne diyeyim bilemiyorum yılları boşa geçirmemişsiniz,çok teşekkür ederim ve başarılarınızın devamını dilerim efendim.

 

[td877]

Olasılık hakkında bir şey söylememişsiniz. Her olasılığa göre kodlar aşağıdadır.

Sub Test1()
    Dim Bak As Range
    Dim i As String
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        If Not Bak = 0 Then 'SAdece A sütunu 0 sıfırsa ekleme
            i = i & Bak & "*" & Bak(1, 2) & "+"
        End If
    Next
    i = Left(i, Len(i) - 1)
    i = "=+(" & i & ")"
    Range("D1").Formula = i
End Sub
Sub Test2()
    Dim Bak As Range
    Dim i As String
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        If Not Bak(1, 2) = 0 Then 'SAdece B sütunu 0 sıfırsa ekleme
            i = i & Bak & "*" & Bak(1, 2) & "+"
        End If
    Next
    i = Left(i, Len(i) - 1)
    i = "=+(" & i & ")"
    Range("D2").Formula = i
End Sub
Sub Test3()
    Dim Bak As Range
    Dim i As String
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        If Not Bak = 0 Or Not Bak(1, 2) = 0 Then 'A ve B sütunlarının ikiside 0 sıfırsa ekleme
            i = i & Bak & "*" & Bak(1, 2) & "+"
        End If
    Next
    i = Left(i, Len(i) - 1)
    i = "=+(" & i & ")"
    Range("D3").Formula = i
End Sub
Sub Test4()
    Dim Bak As Range
    Dim i As String
    For Each Bak In Range("A2:A" & Cells(Rows.Count, "A").End(3).Row)
        If Not Bak = 0 And Not Bak(1, 2) = 0 Then 'A yada B sütunlarından herhangi biri 0 sıfırsa ekleme
            i = i & Bak & "*" & Bak(1, 2) & "+"
        End If
    Next
    i = Left(i, Len(i) - 1)
    i = "=+(" & i & ")"
    Range("D4").Formula = i
End Sub

Sayın Dalgalikur,

Bu macroda hesaplama alanı boşsa ve bundan ötürü hata olduğu zaman error:5 invalid procedure hatası veriyor, hesaplama alanı boşsa hiçbirşey yapmadan devam et ya da macroyu bitir komutu verebilir miyiz excele.

Goto error 0 falan yazdım ama olmadı.

 

[muysun35]

Sayın Dalgalikur,

Bu macroda hesaplama alanı boşsa ve bundan ötürü hata olduğu zaman error:5 invalid procedure hatası veriyor, hesaplama alanı boşsa hiçbirşey yapmadan devam et ya da macroyu bitir komutu verebilir miyiz excele.

Goto error 0 falan yazdım ama olmadı.

On Error Resume Next Kullanın kodun ilk satırı olarak

 

[Muzaffer Ali]

Merhaba.

Arkadaşlar lütfen kullandığınız kodlar içinde "On Error Resume Next " yada "On Error Goto .." gibi hata denetimi kodlar kullanmayın.
Bu kodlar sadece kod yazım aşamasında kullanılabilir. Kod yazımı bittikten sonra hata denetimi kodlarını mutlaka silmelisiniz.

Bunları yazdığınızda hata uyarısı almazsınız evet ama kodlarınızın herhangi bir yerinde başka bir hata olup olmadığını da anlayamazsınız.

Sorunuzun cevabına gelirsek.

i = i & Bak & "*" & Bak(1, 2) & "+"

satırını aşağıdaki ile değiştirin.

If Not Bak = "" And Not Bak(1, 2) = ""

i = i & Bak & "*" & Bak(1, 2) & "+"
end if

 

[td877]

Sayın dalgalıkur,

Teşekkür ederim.