makro ile kelimeleri ayırma

[coşkun79]

Ekteki dosyanın a sütununda ingilizce kelimeler, b sütununda da anları ile birlikte kelimelerin okunuşu bulunmakta. b sütunundaki kelimenin anlamı c sütununa, okunuşunu ise d sütunuda ayrı ayrı yazdıracak bir makroya ihtiyacım var. malum satır sayısı fazla olunca bunu yapmak çok uzun zaman alacak. teşekkürler

 

[parametre]

1. link

2.link

3. link

 

[coşkun79]

teşekkür ederim. ancak formülü uygulayamadım

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kodun, birkaç küçük sorun dışında istediğiniz sonucu vermesi lazım.
.

[FONT="Arial Narrow"][B]Sub KELIME_AYIR()[/B]
Set k = Sheets("KELİMELER")
k.Range("C:D").ClearContents: Set wf = Application.WorksheetFunction
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For satır = 2 To k.Cells(1, 1).End(4).Row
On Error Resume Next
If IsNumeric(wf.Search(")", k.Cells(satır, 2), 1)) Then
    k.Cells(satır, 3) = Mid(k.Cells(satır, 2), 2, wf.Search(")", k.Cells(satır, 2), 1) - 2)
    k.Cells(satır, 4) = Trim(Mid(k.Cells(satır, 2), wf.Search(")", k.Cells(satır, 2), 1) + 1, _
    Len(k.Cells(satır, 2)) - wf.Search(")", k.Cells(satır, 2), 1)))
    If IsNumeric(wf.Search("[", k.Cells(satır, 2), 1)) Then
        k.Cells(satır, 4) = Trim(Mid(k.Cells(satır, 2), wf.Search("]", k.Cells(satır, 2), 1) + 1, _
        Len(k.Cells(satır, 2)) - wf.Search("]", k.Cells(satır, 2), 1)))
    End If
Else
    k.Cells(satır, 3) = Mid(k.Cells(satır, 2), wf.Search("]", k.Cells(satır, 2), 1) + 1, _
    Len(k.Cells(satır, 2)) - wf.Search("]", k.Cells(satır, 2), 1))
End If
    If Len(wf.Substitute(wf.Substitute(k.Cells(satır, 2), ")", ""), "]", "")) = Len(k.Cells(satır, 2)) Or _
        Right(k.Cells(satır, 2), 1) = ")" Then k.Cells(satır, 4) = k.Cells(satır, 2)
Next
Columns("A:D").AutoFit
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem Tamamlandı...", vbInformation, "Ö. BARAN"
[B]End Sub[/B][/FONT]

 

[Korhan Ayhan]

Alternatif;

Sub KELİME_AYIR()
    Son = Cells(Rows.Count, 1).End(3).Row
    Range("C2:D" & Rows.Count).ClearContents
    
    For X = 2 To Son
        If Cells(X, 2) <> "" Then
            Veri = Replace(Cells(X, 2), "=", "")
            If InStr(1, Cells(X, 2), ") ") > 0 Then
                Cells(X, 3) = Split(Veri, ") ")(0) & ")"
                Cells(X, 4) = Split(Veri, ") ")(1)
            Else
                Cells(X, 4) = Veri
            End If
            Veri = ""
        End If
    Next
    MsgBox "İşleminiz tamamlanmıştır."
End Sub