Formulü Sonsuza Dek Devam Ettirme

lavetera · 15 Haziran 2016

Merhaba, benim bi sorum var.
=A1&","&A2&","&A3&","&A4
Şu formülü nasıl istediğim satıra kadar devam ettirebilirim. Mesela A10000 bine kadar devam etmesini istiyorum.
Teşekkürler

Erdem Akdemir · 15 Haziran 2016

Merhaba,

Yerleşik excel fonksiyonları ile yapamazsınız.
Kullanıcı tanımlı fonksiyonlarla yani makro ile yapabilirsiniz.
Forumda hücreleri birleştirme olarak arama yapın.

lavetera · 15 Haziran 2016

Excel

kuvari' Alıntı:
Merhaba,

Yerleşik excel fonksiyonları ile yapamazsınız.
Kullanıcı tanımlı fonksiyonlarla yani makro ile yapabilirsiniz.
Forumda hücreleri birleştirme olarak arama yapın.

Acaba işe yarar konunun linkini verebilir misiniz. Forumda bulamadım da.

Tevfik_Kursun · 15 Haziran 2016

Merhaba,
Aramıza hoşgeldiniz.
Siteden elde ettiğim ekli kodu bir modüle kopyalayınız

Kod:

Function birleştirme(hedef As Range, Optional ayırac As String = ",") As String
    Dim alan As Range
    Dim sonuc As String
      For Each alan In hedef
        If alan.Value <> "" Then
            sonuc = sonuc & ayırac & alan.Value
        End If
    Next alan
    If sonuc <> "" Then
        sonuc = Mid(sonuc, Len(ayırac) + 1)
    End If
    birleştirme = sonuc
End Function

çalışma şekli ise,
A5:A11 arasındaki hücrelerde olanları A1'e

Kod:

=birleştirme(A5:A11)

ifadesiyle alacaktır
Bu vesile ile bu KTF 'yi yazan adını bilmediğim üstad arkadaşa teşekkür eder saygılar sunarım
Kolay gelsin

Erdem Akdemir · 15 Haziran 2016

Merhaba,

Tag'daki KTF'yi boş bir modüle yapıştırın.

=birlest(birleştirilecek alan ; kullanılacak imleç)

Kod:

Function birlest(hucre As Range, Optional imlec As String = "") As String

For Each alan In hucre

k = k & alan & imlec

Next alan

If imlec = "" Then
birlest = k
Else
birlest = VBA.Left(k, VBA.Len(k) - 1)
End If
End Function

lavetera · 15 Haziran 2016

Tevfik_Kursun' Alıntı:
Merhaba,
Aramıza hoşgeldiniz.
Siteden elde ettiğim ekli kodu bir modüle kopyalayınız

Kod:

Function birleştirme(hedef As Range, Optional ayırac As String = ",") As String Dim alan As Range Dim sonuc As String For Each alan In hedef If alan.Value <> "" Then sonuc = sonuc & ayırac & alan.Value End If Next alan If sonuc <> "" Then sonuc = Mid(sonuc, Len(ayırac) + 1) End If birleştirme = sonuc End Function

çalışma şekli ise,
A5:A11 arasındaki hücrelerde olanları A1'e

Kod:

=birleştirme(A5:A11)

ifadesiyle alacaktır
Bu vesile ile bu KTF 'yi yazan adını bilmediğim üstad arkadaşa teşekkür eder saygılar sunarım
Kolay gelsin

Malesef bu makro kodunu nereye yapıştıracağımı bilmiyorum. Yardımcı olabilirseniz sevinirim

lavetera · 15 Haziran 2016

Tevfik_Kursun' Alıntı:
Merhaba,
Aramıza hoşgeldiniz.
Siteden elde ettiğim ekli kodu bir modüle kopyalayınız

Kod:

Function birleştirme(hedef As Range, Optional ayırac As String = ",") As String Dim alan As Range Dim sonuc As String For Each alan In hedef If alan.Value <> "" Then sonuc = sonuc & ayırac & alan.Value End If Next alan If sonuc <> "" Then sonuc = Mid(sonuc, Len(ayırac) + 1) End If birleştirme = sonuc End Function

çalışma şekli ise,
A5:A11 arasındaki hücrelerde olanları A1'e

Kod:

=birleştirme(A5:A11)

ifadesiyle alacaktır
Bu vesile ile bu KTF 'yi yazan adını bilmediğim üstad arkadaşa teşekkür eder saygılar sunarım
Kolay gelsin

Şimdi hallettim. Bu kodun kalıcı olmasını nasıl sağlarım. İlla modul açık mı olması lazım

Erdem Akdemir · 15 Haziran 2016

Bu kodun bulunduğu excel'i farklı kaydetten excel eklentisi olarak kaydedin.
Dosya>Seçenekler>Eklentiler'den bu dosyayı excel'in içine kurulumunu yapabilirsiniz.

lavetera · 15 Haziran 2016

kuvari' Alıntı:
Bu kodun bulunduğu excel'i farklı kaydetten excel eklentisi olarak kaydedin.
Dosya>Seçenekler>Eklentiler'den bu dosyayı excel'in içine kurulumunu yapabilirsiniz.

Peki her bu olayın aynısı ama her hücrenin başı sonuna tırnak koymak istersem nasıl yapabilirim
Örnek: '25','34','45'...................
böyle devam ediyor

Tevfik_Kursun · 15 Haziran 2016

Arkadaş,

Kod:

Function birleştirme(hedef As Range, Optional ayırac As String = ",") As String

satırdaki "," ifadesini "','" şeklinde değiştiriniz.
iyi çalışmalar

Korhan Ayhan · 15 Haziran 2016

Alternatif;

Kod:

Function KBİRLEŞTİR(Alan As Range, Optional Kriter = ",") As String
    Dim Veri As Range
    For Each Veri In Alan
        If Veri.Value <> "" Then
            If KBİRLEŞTİR = "" Then
                KBİRLEŞTİR = "'" & Veri.Value & "'"
            Else
                KBİRLEŞTİR = KBİRLEŞTİR & Kriter & "'" & Veri.Value & "'"
            End If
        End If
    Next
End Function

lavetera · 16 Haziran 2016

Tevfik_Kursun' Alıntı:
Arkadaş,

Kod:

Function birleştirme(hedef As Range, Optional ayırac As String = ",") As String

satırdaki "," ifadesini "','" şeklinde değiştiriniz.
iyi çalışmalar

Çok teşekkürler. Ama bir sorum daha olucak. Şu an bu formülü kullanınca ilk ve son girdiye tırnak işareti eklenmiyor. Makroya bunu nasıl ekleyebiliriz?

Tevfik_Kursun · 16 Haziran 2016

Merhaba,

Kod:

=[COLOR="magenta"]"[/COLOR]'[COLOR="magenta"]"&[COLOR="Black"]birleştirme(A1:A11)[/COLOR]&"[/COLOR]'[COLOR="Magenta"]"[/COLOR]

işinizi göreceğini düşünüyorum
Kolay gelsin

lavetera · 20 Haziran 2016

Korhan Ayhan' Alıntı:

Alternatif;

Kod:

Function KBİRLEŞTİR(Alan As Range, Optional Kriter = ",") As String
    Dim Veri As Range
    For Each Veri In Alan
        If Veri.Value <> "" Then
            If KBİRLEŞTİR = "" Then
                KBİRLEŞTİR = "'" & Veri.Value & "'"
            Else
                KBİRLEŞTİR = KBİRLEŞTİR & Kriter & "'" & Veri.Value & "'"
            End If
        End If
    Next
End Function

Merhaba
Ben bu makroda bazı hücrelerin atlanmasını istiyorum. Mesela bazı hücrelerde çift tırnak var. Bu sefer benim tırnaklamam ile karışıyor. O yüzden çift tırnak içeren hücrelerin ayrı bi yerde toplanmasını istiyorum. Bunu nasıl yapabilirim acaba?

Korhan Ayhan · 20 Haziran 2016

Örnek dosya ekleyebilir misiniz?

Ona göre kodu revize edelim.

Lütfen dosyanızda nasıl sonuç görmek istediğinizi de belirtin.

lavetera · 20 Haziran 2016

Korhan Ayhan' Alıntı:
Örnek dosya ekleyebilir misiniz?

Ona göre kodu revize edelim.

Lütfen dosyanızda nasıl sonuç görmek istediğinizi de belirtin.

http://s4.dosya.tc/server2/37gjtn/TEST2.rar.html

Dosyayı buraya atabildim anca. Bu örnek tabi. Benim istediğim şey; gördüğünüz gibi A sütununda bazı hücrelerde " işareti var. Bu işaret olanların B sütunundaki makrolu yerlere geçmesini istemiyorum. Yani tırnak işareti olan hücreler hatalı olarak görülcek. O yüzden o hücrelerin başka bir yerde hücrede kendi aralarında makroyu gerçekleştirsin istiyorum. Formül olmasa bile en azından başka bi sütunda dizilseler de olur.
Şimdiden teşekkürler

Asri · 20 Haziran 2016

@Korhan Ayhan ın kodunda değişiklik yaptım.

Asıl veride değişiklik yapmadan, işleme başlamadan önce " ları siliyor.

Kod:

Function birleştirme2(Alan As Range, Optional Kriter = ",") As String
    Dim Veri As Range
    For Each Veri In Alan
        deger = Veri.Value
        deger = Replace(deger, """", "")
        If Veri.Value <> "" Then
            If birleştirme2 = "" Then
                birleştirme2 = "'" & deger & "'"
            Else
                birleştirme2 = birleştirme2 & Kriter & "'" & deger & "'"
            End If
        End If
    Next
End Function

Korhan Ayhan · 20 Haziran 2016

Aşağıdaki fonksiyonları kullanabilirsiniz.

Kod:

Function KBİRLEŞTİR(Alan As Range, Optional Kriter = ",") As String
    Dim Veri As Range
    For Each Veri In Alan
        If Veri.Value <> "" Then
            If InStr(1, Veri.Value, """") = 0 Then
                If KBİRLEŞTİR = "" Then
                    KBİRLEŞTİR = "'" & Veri.Value & "'"
                Else
                    KBİRLEŞTİR = KBİRLEŞTİR & Kriter & "'" & Veri.Value & "'"
                End If
            End If
        End If
    Next
End Function

Kod:

Function EBİRLEŞTİR(Alan As Range, Optional Kriter = ",") As String
    Dim Veri As Range
    For Each Veri In Alan
        If Veri.Value <> "" Then
            If InStr(1, Veri.Value, """") > 0 Then
                If EBİRLEŞTİR = "" Then
                    EBİRLEŞTİR = Veri.Value
                Else
                    EBİRLEŞTİR = EBİRLEŞTİR & Kriter & Veri.Value
                End If
            End If
        End If
    Next
End Function

lavetera · 20 Haziran 2016

asri' Alıntı:

@Korhan Ayhan ın kodunda değişiklik yaptım.

Asıl veride değişiklik yapmadan, işleme başlamadan önce " ları siliyor.

Kod:

Function birleştirme2(Alan As Range, Optional Kriter = ",") As String
    Dim Veri As Range
    For Each Veri In Alan
        deger = Veri.Value
        deger = Replace(deger, """", "")
        If Veri.Value <> "" Then
            If birleştirme2 = "" Then
                birleştirme2 = "'" & deger & "'"
            Else
                birleştirme2 = birleştirme2 & Kriter & "'" & deger & "'"
            End If
        End If
    Next
End Function

Teşekkürler ama bu kodla çift tırnaklar(sadece tırnak) siliniyor. Ben ise çift tırnaklılar ayrı tutulsun istiyorum. Yani errorler için ayrı bi dizi yapmak istiyorum.

lavetera · 20 Haziran 2016

Korhan Ayhan' Alıntı:

Aşağıdaki fonksiyonları kullanabilirsiniz.

Kod:

Function KBİRLEŞTİR(Alan As Range, Optional Kriter = ",") As String
    Dim Veri As Range
    For Each Veri In Alan
        If Veri.Value <> "" Then
            If InStr(1, Veri.Value, """") = 0 Then
                If KBİRLEŞTİR = "" Then
                    KBİRLEŞTİR = "'" & Veri.Value & "'"
                Else
                    KBİRLEŞTİR = KBİRLEŞTİR & Kriter & "'" & Veri.Value & "'"
                End If
            End If
        End If
    Next
End Function

Kod:

Function EBİRLEŞTİR(Alan As Range, Optional Kriter = ",") As String
    Dim Veri As Range
    For Each Veri In Alan
        If Veri.Value <> "" Then
            If InStr(1, Veri.Value, """") > 0 Then
                If EBİRLEŞTİR = "" Then
                    EBİRLEŞTİR = Veri.Value
                Else
                    EBİRLEŞTİR = EBİRLEŞTİR & Kriter & Veri.Value
                End If
            End If
        End If
    Next
End Function

Çok teşekkürler tam istediğim gibi olmuş. Acaba sırf virgülle ayrılan makroya bunu nasıl uyarlayabiliriz.

Formulü Sonsuza Dek Devam Ettirme

lavetera

Erdem Akdemir

Destek Ekibi

lavetera

Tevfik_Kursun

Erdem Akdemir

Destek Ekibi

lavetera

lavetera

Erdem Akdemir

Destek Ekibi

lavetera

Tevfik_Kursun

Korhan Ayhan

Administrator

lavetera

Tevfik_Kursun

lavetera

Korhan Ayhan

Administrator

lavetera

Asri

Korhan Ayhan

Administrator

lavetera

lavetera