Hücreden metin almak

[mersilen]

Merhabalar
Tablo içerisindeki hücredeki metini yan sütuna nasıl yazdırabiliriz

 

[turist]

Dosyanız eklidir.

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodlar işinizi görür mü acaba?

Sub kod1()
For a = 2 To Range("C65500").End(3).Row
    metin = Split(Cells(a, "C").Text, Chr(10))
    met = Replace(metin(13), "onarım : ", "")
    met = WorksheetFunction.Trim(met)
    Cells(a, "D") = WorksheetFunction.Proper(met)
Next
End Sub

Alternatif:

Sub kod2()
For a = 2 To Range("C65500").End(3).Row
    metin = Split(Cells(a, "C").Text, Chr(10))
    For Each met In metin
        If met Like "onarım*" Then
            met = Replace(met, "onarım : ", "")
            met = WorksheetFunction.Trim(met)
            Cells(a, "D") = WorksheetFunction.Proper(met)
        End If
    Next
Next
End Sub

 

[mersilen]

Herkese teşekkür ederim.
Kodları orjinal tabloya uyarladım ama bilgisayarı kasıyor
Rica etsem yeni yüklediğim tabloda vb dictionary ve sql kodu ile yapmak mümkün mü?
Her iki yöntem ayrı ayrı olursa iyi olur.

 

[Korhan Ayhan]

Ekteki dosyayı deneyiniz.

 

[ÖmerBey]

Tekrar merhaba,
Sözlük örneği...

Sub kod()
Set soz = CreateObject("Scripting.Dictionary")
On Error Resume Next
son = Range("C65500").End(3).Row
For a = 2 To son
    metin = Split(Cells(a, "C").Text, Chr(10))
    sr = WorksheetFunction.Match("Pla?enta*", metin, 0)
    met = Split(metin(sr - 1), ":")(1)
    met = WorksheetFunction.Trim(met)
    soz.Add Key:=Cells(a, "A"), Item:=WorksheetFunction.Proper(met)
    met = ""
Next
Range("D2:D" & son) = Application.Transpose(soz.items)
End Sub