Formulü Sonsuza Dek Devam Ettirme

L

lavetera

Katılım
15 Haziran 2016
Mesajlar
17
Excel Vers. ve Dili
excel 2011
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
 
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.
 
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.
Genişletmek için tıkla ...

Acaba işe yarar konunun linkini verebilir misiniz. Forumda bulamadım da.
 
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
 
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
 
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
Genişletmek için tıkla ...

Malesef bu makro kodunu nereye yapıştıracağımı bilmiyorum. Yardımcı olabilirseniz sevinirim
 
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
Genişletmek için tıkla ...

Şimdi hallettim. Bu kodun kalıcı olmasını nasıl sağlarım. İlla modul açık mı olması lazım
 
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.
 
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.
Genişletmek için tıkla ...

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
 
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
 
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
 
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
Genişletmek için tıkla ...

Ç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?
 
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
 
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
Genişletmek için tıkla ...

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?
 
Örnek dosya ekleyebilir misiniz?

Ona göre kodu revize edelim.

Lütfen dosyanızda nasıl sonuç görmek istediğinizi de belirtin.
 
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.
Genişletmek için tıkla ...

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
 
@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
 
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
 
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
Genişletmek için tıkla ...


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.
 
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
Genişletmek için tıkla ...

Çok teşekkürler tam istediğim gibi olmuş. Acaba sırf virgülle ayrılan makroya bunu nasıl uyarlayabiliriz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst