مساعده من اجل تعلم الانجليزيه عبر ترجمه الافلام

[علي الهتاري]

السلام عليكم ممكن طريقه معرفه الكلمات التكراريه وليس الجمل كم مره تكررت وترقيمها بجانبها حسب عدد التكرر مرفق صوره وملف الاكسل

 

[ياسر خليل أبو البراء]

أخي الكريم

يرجى وضع تصور للنتائج المتوقعة ..قم بضرب مثالين للتوضيح

...

 

[علي الهتاري]

مااقصده موضح في الصوره

[ياسر خليل أبو البراء]

ولكن الجملة الواحدة تحتوي على اكثر من كلمة ..كيف ستكون النتائج في هذه الحالة ؟؟؟

أقصد توجد كلمات The و world و of و investing ...كيف سيتعامل الإكسيل مع النتائج المتوقعة؟

وماذا عن بقية الأسطر الموجودة والتي تحتوي على علامات <> أو التوقيت ...؟؟

[علي الهتاري]

مثلا كلمه the تكرارها 1119 اريد ان يظهر الرقم 1119 بجانب كل كلمه the وبكذا استطيع معرفه اكثر الكلمات تكرار 

باالنسبه لتوقيت وبقيه الاسطركما هيا لا نغير فيها اي شيء 

لان الفكره ان اغير الملف من اكسل الى text  ثم يدمج الملف معا الفلم 

[ياسر خليل أبو البراء]

أخي العزيز

يرجى تغيير اسم الظهور للغة العربية كما يرجى إرفاق ملفك به بعض النتائج المتوقعة ليسهل توضيح الطلب بشكل أدق ..

تقبل تحياتي

[علي الهتاري]

مرفق ملف اكسل يوضح الفكره مختلف عن الاكسل السابق  ارجو اعتماده 

789.rar

[ياسر خليل أبو البراء]

أخي الكريم علي الهتاري

إليك الكود التالي فيه تنفيذ ما طلبت إن شاء الله

Sub Test()
    Dim collWord As New Collection, collRow As New Collection, arrIn, arrOut, arrCalc(1 To 50000) As Long
    Dim I As Long, J As Long, P As Long, strKey1 As String, strKey2 As String, V1, V2
    
    arrIn = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Formula
    arrOut = arrIn
    arrIn(1, 1) = ""
    For I = 1 To UBound(arrIn, 1)
        If Trim(arrIn(I, 1)) = "" Then
            For J = 0 To 2
                arrIn(I + J, 1) = ""
            Next J
            I = I + 3
        End If
    Next I
    
    With CreateObject("Vbscript.Regexp")
        .Global = True
        .IgnoreCase = True
        
        .Pattern = "[A-z0-9']+"
        For I = 1 To UBound(arrIn, 1)
            If Len(arrIn(I, 1)) Then
                strKey1 = Trim(CStr(I))
                If InStrB(1, arrIn(I, 1), "<i>") Then arrIn(I, 1) = Replace(arrIn(I, 1), "<i>", Chr$(1)): arrOut(I, 1) = arrIn(I, 1)
                If InStrB(1, arrIn(I, 1), "</i>") Then arrIn(I, 1) = Replace(arrIn(I, 1), "</i>", Chr$(2)): arrOut(I, 1) = arrIn(I, 1)
                If .Test(arrIn(I, 1)) Then
                    For Each V1 In .Execute(arrIn(I, 1))
                        strKey2 = CStr(V1)
                        On Error Resume Next
                        collRow.Add Key:=strKey1, Item:=Array(I, New Collection)
                        collRow(strKey1)(1).Add Key:=strKey2, Item:=strKey2
                        
                        collWord.Add Key:=strKey2, Item:=collWord.Count + 1
                        P = collWord(strKey2)
                        arrCalc(P) = arrCalc(P) + 1
                        On Error GoTo 0
                    Next V1
                End If
                
            End If
        Next I
        
        For Each V1 In collRow
            I = V1(0)
            For Each V2 In V1(1)
                J = arrCalc(collWord(V2))
                .Pattern = "\b" & V2 & "\b"
                arrOut(I, 1) = .Replace(arrOut(I, 1), V2 & "*" & J & "*")
            Next V2
            If InStrB(1, arrOut(I, 1), Chr$(1)) Then arrOut(I, 1) = Replace(arrOut(I, 1), Chr$(1), "<i>")
            If InStrB(1, arrOut(I, 1), Chr$(2)) Then arrOut(I, 1) = Replace(arrOut(I, 1), Chr$(2), "</i>")
            arrOut(I, 1) = "'" & arrOut(I, 1)
        Next V1
    End With
    
    Range("B1").Resize(UBound(arrOut, 1)).Value = arrOut
    Range("B1").Value = "النتائج المطلوبة"
End Sub

وإليك الملف المرفق فيه تطبيق الكود

تقبل تحياتي

 

Movies Count Words.rar

[علي الهتاري]

شكرا لك استاذ ياسر انا مبتدى في الاكسل اضفت الكود ولم استطع التعامل معه ممكن شرح مبسط

[ياسر خليل أبو البراء]

أخي الكريم هل قمت بتحميل الملف الذي أرفقته ؟؟

الملف جاهز للعمل فقط قم بالنقر على زر الأمر ليتم التنفيذ

شاهد الفيديو التالي عله يفيدك

 

 

Watch.rar

[علي الهتاري]

شكراُ لك استاذ ياسر 

[ياسر خليل أبو البراء]

أخي الكريم علي أفضل من الشكر قول : جزاك الله خيراً

والحمد لله أن تم المطلوب على خير ..

تقبل تحياتي

[علي الهتاري]

جزاك الله خيراًوالحمد لله أن تم المطلوب على خير

ووفقك الله وبارك لك في وقتك وعلمك وجهدك وعمرك