Isme Gore Birleştirme

[skaan]

Merhaba;
Ekli dosyada verilen bilgilerde A sutunundaki isimlere göre C sutununda bulunan isimlerin karşısına D sutununda birleştirmek istiyorum.. nasıl bir formul uygulayabilirim..
Örneğin ; kaan..... okula git
yardımcı olursanız çok sevinirim..
Saygılarımla,
SKaan

 

[Erdal]

Merhabalar
özne, nesne ve fiilleri ayrı sütunlara yazıp =özne&nesne&fiil formülü işinizi görmez mi?

 

[Ayşavkı]

Merhaba sayın skaan!!! doğru anladı isem D1 hücresine =C1&B1&B2 formülünü uygulamanızı öneririm.saygılar!!!

 

[Ayşavkı]

merhaba sayın Erdal!!! cevabınızı görmedim.özür dilerim.saygılar!!!

 

[Erdal]

merhaba sayın Erdal!!! cevabınızı görmedim.özür dilerim.saygılar!!!

Estafirullah sayın Ayşavkı

 

[skaan]

Merhaba;
cevaplar için tesekkurler ama anlatamadım ben galiba .. Ekli dosyada Kırmızı ile belirttiğim isimlerin yanına B sutunundaki karsılarına gelen metinleri birlestirmek istiyorum .Kaan ismini görunce butun kaanların karsılarındakı metınlerı bırlestırecegım. sadece A sutunundaki kaan - ayse - fatma isimlerinin karsılarındaki metinler kırmızı ile yazılan isimlerin yanındaki D sutununda birleşecek.. (Formul Kullanarak yapabilirsem Harika Olur ) Anlatabildim insallah..
Saygılar
Skaan

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub BİRLEŞTİR()
    Dim X As Long, BUL As Range, ADRES As String
    
    Range("D:D").ClearContents
    
    For X = 1 To Range("C65536").End(3).Row
        Set BUL = Range("A:A").Find(Cells(X, "C"), , , xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            If Cells(X, "D") = "" Then
                Cells(X, "D") = BUL.Offset(0, 1)
            Else
                Cells(X, "D") = Cells(X, "D") & "-" & BUL.Offset(0, 1)
            End If
        Set BUL = Range("A:A").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
    Next
    
    Set BUL = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[skaan]

Yardımlarınız için çok teşekkür ederim..

 

[1Al2Ver]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub BİRLEŞTİR()
    Dim X As Long, BUL As Range, ADRES As String
    
    Range("D:D").ClearContents
    
    For X = 1 To Range("C65536").End(3).Row
        Set BUL = Range("A:A").Find(Cells(X, "C"), , , xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            If Cells(X, "D") = "" Then
                Cells(X, "D") = BUL.Offset(0, 1)
            Else
                Cells(X, "D") = Cells(X, "D") & "-" & BUL.Offset(0, 1)
            End If
        Set BUL = Range("A:A").FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
    Next
    
    Set BUL = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Merhaba,

Kod, ilk satırdaki kaan (C1) için D1'e , "okula-git" yazacağına, "git-okula" yazıyor,

Diğerlerinde sorun yok,

2003 kullandığım için olabilir mi ?

Teşekkür ederim.

 

[1Al2Ver]

Merhaba,

Kod, ilk satırdaki kaan (C1) için D1'e , "okula-git" yazacağına, "git-okula" yazıyor,

Diğerlerinde sorun yok,

2003 kullandığım için olabilir mi ?

Teşekkür ederim.

Merhaba,

Kod'a yorum yada çözüm rica ediyorum,

Teşekkür ederim.

 

[İhsan Tank]

Merhaba,

Kod'a yorum yada çözüm rica ediyorum,

Teşekkür ederim.

Hatalı dosyayı ekler misiniz_?

 

[halit3]

Merhaba,

Kod, ilk satırdaki kaan (C1) için D1'e , "okula-git" yazacağına, "git-okula" yazıyor,

Diğerlerinde sorun yok,

2003 kullandığım için olabilir mi ?

Teşekkür ederim.

Hatırladığım kadarı ile Find komutu kullanırken ilk veri A1 hücresini görmüyor bu konuda microsoftun makalesi olması lazım.

buradaki verilerin hepsini bir satır aşağıya kaydırırsanız olumlu sonuç alırsınız.

 

[1Al2Ver]

Sayın İhsan Tank merhaba,

İlginiz için teşekkür ederim, dosya 1 no.lu mesajda mevcut.

Sayın halit3 merhaba,

Öneriniz doğrultusunda dosyanın hatası düzeldi, teşekkür ederim.

 

[İhsan Tank]

Sayın İhsan Tank merhaba,

İlginiz için teşekkür ederim, dosya 1 no.lu mesajda mevcut.

Sayın halit3 merhaba,

Öneriniz doğrultusunda dosyanın hatası düzeldi, teşekkür ederim.

Merhaba
İlk satırdan başlamak için lütfen bunu deneyin

Option Explicit
Sub birleş()
Dim ts, kaplan, bordo
ts = MsgBox("Veri Karşılıklarını Birleştiriyorum", vbYesNo, "Onay")
If ts = vbNo Then Exit Sub
Application.ScreenUpdating = False
Range("D:D").ClearContents
For ts = 1 To Cells(65536, "C").End(xlUp).Row
bordo = 0
For kaplan = 1 To Cells(65536, "A").End(xlUp).Row
If Cells(kaplan, "A") = Cells(ts, "C") Then
bordo = bordo & "-" & Cells(kaplan, "B")
End If
Next
Cells(ts, "D") = Mid(bordo, 3, Len(bordo))
Next
Application.ScreenUpdating = True
MsgBox "Veri Karşılıklarını Birleştirdim", vbInformation, "Bitiş"
End Sub

 

[Ömer]

Merhaba,

Kod, ilk satırdaki kaan (C1) için D1'e , "okula-git" yazacağına, "git-okula" yazıyor,

Diğerlerinde sorun yok,

2003 kullandığım için olabilir mi ?

Teşekkür ederim.

Find ile ilk hücre çözümü için;

Sub Birlestir()
 
    Dim c As Range, Adr As Variant, i As Long, sonhcr As Range
 
    Application.ScreenUpdating = False
    Range("D:D").ClearContents
 
    With Range("A:A")
        [COLOR=slategray]Set sonhcr = .Cells(.Cells.Count)[/COLOR]
        For i = 1 To Cells(Rows.Count, "C").End(xlUp).Row
            Set c = .Find(Cells(i, "C"), [COLOR=slategray]sonhcr[/COLOR], xlValues, xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    Cells(i, "D") = Cells(i, "D") & "-" & Cells(c.Row, "B")
 
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
         Cells(i, "D") = WorksheetFunction.Substitute(Cells(i, "D"), "-", "", 1)
        Next i
    End With
 
    Set sonhcr = Nothing: Set c = Nothing
 
    Application.ScreenUpdating = True
    MsgBox "İşlem tamam.", vbInformation, "excel.web.tr"
 
End Sub

.