كيف استبدال عدة نصوص لنص واحد فى ملف اكسيل

[mr.mohamed2]

السلام عليكم

اول مشاركة ليا فى المنتدى ارجو الاقى حل لمشكلتى

عندى ملفات اكسيس ترد من مئات المدخلين وكل واحد منهم يكتب نصوص مختلفة لنفس الشيئ

المطلوب  1 - استبدال عدة نصوص وهى كلها مترادفات الى نص واحد فقط ولكن على مستوى عمود واحد حتى لايؤثر على البيانات فى باقى الاعمدة

المطلوب 2 - استبدال او مسح جميع الرموز المكتوبة فى الملف كالشرطة او (لا يوجد) من جميع الاعمدة فى خطوة واحدة حتى يمكن تصدير الملف لقاعدة بيانات فى وقت لاحق

 

وتقبلوا خالص تحياتى

مرفق ملف كمثال

مثال.rar

[سليم حاصبيا]

اكتب هذه المعادلة في الخلية A2  تم اسحب نزولاًُ

مع وضع الكلمة التي تريد في الخلية H1

=IF(ISNUMBER($A2),$H$1,"")

[mr.mohamed2]

الف شكر اخى سليم

تم التجربة ولم تنجح الدالة

معذرة انا اريد كود لوضعه فى ميديول لان ماركات السيارات ستكون غير مرتبة ..بمعنى ان الخلايا ستكون فى عمود واحد ولن تكون متتالية

لذلك انا اريد كود لكى اكرره لكل الماركات ايضاً وانفذه على عمود واحد

بمعنى انه ساكرر الكود لشيفروليه ثم اكرره للسوزوكى ثم للجيب وهكذا ... ولان الخلايا ليست متتالية لذلك لا استطيع ان اسحب الدالة الى الخلايا فى خطوة واحدة

اخيرا تقبل تحياتى وشكرا على الاهتمام والرد السريع

تم تعديل مارس 7, 2015 بواسطه mr.mohamed2

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

الأخ الحبيب مستر محمد

إليك الملف التالي فيه عدد 2 موديول كل موديول منفصل .

وقمت بإضافة شيت أي ورقة عمل باسم Conditions ضع في العمود الأول الكلمة المراد التخلص منها ، والعمود الثاني للكلمة الجديدة .. لأي عدد من الكلمات .. يعني مش هتضطر تكتب كود لكل نوع سيارة ... فقط اكتب كل الكلمات التي تريد استبدالها ..

ولو الحل عجبك متنساش تضغط أفضل إجابة .

تقبل تحياتي

 

Replacement Multiple Instances.rar

[سليم حاصبيا]

تم التعديل على قدر ما فهمت من المشاركة

يمكنك تحديد اي خلية في العامود B   و تظهر لك قائمة منسدلة تختار منها ماتريد

يمكن زيادة العناصر في القائمة المنسدلة او تعديلها من خلال الصفحة 2

القائمة المنسدلة لا تظهر اذا لم يكن هناك ترقيم في العمود  A    

مثال 1.rar

[mr.mohamed2]

الف شكر يا استاذ ياسر فعلا هو المطلوب تماماً لكن قابلتنى بعد الاخطاء الغير مرغوبة وهى

اولاً : مديول الاستبدال يعمل فى كل الاعمدة لكن المطلب هو عمله فى عمود واحد فقط ولا يؤثر على التغيير فى باقى الاعمدة  (انا سأكرره يدويا فى كل عمود على حدى بعد تغيير البيانات حسب نوع العمود)

ثانياً : مديول الالغاء يعمل تماما كما هو المطلوب لكن عند اضافة رموز اخرى لا يلغيها (بمعنى عند اضافة ** او/// او (لا يوجد) لا يقوم بتغيريها ) فممكن عمل مديول الالغاء كما مديول التغير لكي استطيع ان اضيف ايه كلمات غير مرغوبة  ومسحها مرة واحدة

 

ثالثا سؤال : كيف يمكن لى نسخ هذا المديول لملفات اخرى وكيف يمكن تحريره لكي اجعله يعمل على عمود اخر c  و d مثلاً بدلا من a و b

[mr.mohamed2]

الف شكر يا استاذ سليم لكن انا اريد ان اصحح الاخطاء فى خطوة واحدة وليست خلية تلو الاخرى مع العلم بأن الملفات تأتى لي بعد ملئها ولا يمكن التعديل فى الملفات قبل ارسالها لي لانها ليست تحت يدى (الملفات ترسل لي بالبريد) لذلك لا يمكنى عمل اى قوائم منسدلة

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

أخي الحبيب

قم بالبحث عن هذه الكلمة داخل الكود

Cells.Replace

في منتصف الكود تقريبا

واستبدلها بالتالي فقط

استبدل كلمة Cells بكلمة Rng

لتصبح

Rng.Replace

مع الاحتفاظ بباقي السطر كما هو

حاول أن تدرس الكود حتى تستطيع أن تطبقه على أي عمود أو نطاق ..هناك سطر باللون الأخضر ، كتعليق للسطر المراد التعديل عليه

بالنسبة لثانيا : الكلمات التي أشرت إليها موجودة في الموديول الثاني يمكنك إضافة المزيد إذا أردت على نفس المنوال ..

أرجو الإطلاع على الكود أولا ثم إذا صادفتك مشكلة أبلغنا بها

[mr.mohamed2]

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

تم التجربة  وقد تعلمت ان تبديل كلمة   Cells.Replace    بكلمة Rng.Replace تجعل الكود يعمل على عمةد واحد فقط

وجارى التجربة على عمل الميديول على عمود اخر (مما افهمه انى المفروض اغير اسم العمود فقط من الكود)

 

ثانيا ماذ افعل لتعديل على المديول الاول لاجعله يمسح البيانات فقط ولا يضع ايه كلمات مكانه؟

تقبل خالص تحياتى وجزيل شكرى

تم تعديل مارس 8, 2015 بواسطه mr.mohamed2

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

كود الاستبدال بعد التعديل

Sub Replacement()
    Dim Rng As Range
    Dim LR As Long, LastRow As Long
    Dim X As Long, Cell As Range
    
    LR = Sheets("Conditions").Cells(Rows.Count, "A").End(xlUp).Row
    LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Sheets("Sheet1").Range("B2:B" & LastRow) 'هذا النطاق الذي سيتم العمل عليه
    
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        For X = 1 To LR
            Rng.Replace What:=Sheets("Conditions").Range("A" & X), Replacement:=Sheets("Conditions").Range("B" & X), _
            Lookat:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:= _
            False, ReplaceFormat:=False
        Next X
        
        For Each Cell In Rng
            Cell.Value = Application.WorksheetFunction.Trim(Cell)
        Next Cell
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

رغم أن التعديل بسيط .. في كلمة واحدة فقط Cells أصبحت Rng

هذا هو كل التغيير

كود مسح البيانات الغير مرغوب فيها

Sub ClearSpeicific()
    Dim Cell As Range
    Application.ScreenUpdating = False
        For Each Cell In Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
            If Cell.Value = "ــــ" Or Cell.Value = "ــــــ" Or Cell.Value = "*" Or Cell.Value = "/" Or Cell.Value = "لا يوجد" Then Cell.Value = ""
        Next Cell
    Application.ScreenUpdating = True
End Sub

ركز على هذا السطر

If Cell.Value = "ــــ" Or Cell.Value = "ــــــ" Or Cell.Value = "*" Or Cell.Value = "/" Or Cell.Value = "لا يوجد" Then Cell.Value = ""

حاول أن تفهمه وأضف إليه ما تريد مسحه من بيانات

معناه : إذا كانت قيمة الخلية = كذا أو قيمة الخلية تساوي كذا أو أو أو .. ضيف شروط زي ما إنت عايز .. في الآخر بعد كلمة Then تصبح الخلية إذا تحقق أي من الشروط فارغة ""

أرجو أن تكون قد استوعبت الأمر

[mr.mohamed2]

ممكن طلب تاني يا استاذ ياسر

كيف تصدير واستيراد ماكرو فى اكسيل

[mr.mohamed2]

كود الاستبدال بعد التعديل

Sub Replacement()
    Dim Rng As Range
    Dim LR As Long, LastRow As Long
    Dim X As Long, Cell As Range
    
    LR = Sheets("Conditions").Cells(Rows.Count, "A").End(xlUp).Row
    LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Sheets("Sheet1").Range("B2:B" & LastRow) 'هذا النطاق الذي سيتم العمل عليه
    
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        For X = 1 To LR
            Rng.Replace What:=Sheets("Conditions").Range("A" & X), Replacement:=Sheets("Conditions").Range("B" & X), _
            Lookat:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:= _
            False, ReplaceFormat:=False
        Next X
        
        For Each Cell In Rng
            Cell.Value = Application.WorksheetFunction.Trim(Cell)
        Next Cell
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

رغم أن التعديل بسيط .. في كلمة واحدة فقط Cells أصبحت Rng

هذا هو كل التغيير

كود مسح البيانات الغير مرغوب فيها

Sub ClearSpeicific()
    Dim Cell As Range
    Application.ScreenUpdating = False
        For Each Cell In Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
            If Cell.Value = "ــــ" Or Cell.Value = "ــــــ" Or Cell.Value = "*" Or Cell.Value = "/" Or Cell.Value = "لا يوجد" Then Cell.Value = ""
        Next Cell
    Application.ScreenUpdating = True
End Sub

ركز على هذا السطر

If Cell.Value = "ــــ" Or Cell.Value = "ــــــ" Or Cell.Value = "*" Or Cell.Value = "/" Or Cell.Value = "لا يوجد" Then Cell.Value = ""

حاول أن تفهمه وأضف إليه ما تريد مسحه من بيانات

معناه : إذا كانت قيمة الخلية = كذا أو قيمة الخلية تساوي كذا أو أو أو .. ضيف شروط زي ما إنت عايز .. في الآخر بعد كلمة Then تصبح الخلية إذا تحقق أي من الشروط فارغة ""

أرجو أن تكون قد استوعبت الأمر

 

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

وانا عدلت المشاركة السابقة لكى اعلمك بالنتيجة

ارجو من حضرتك مراجعة مشاركتى (انا تعبتك جدا جدا جزالك الله خيرا)

السؤال هو لو عايز اعدل فى الماكرو بحيث انه يمسح فقط دون استبدال ماذا ساغير فى الكود

السؤال الاخير كيفية نسخ ماكرو الى ماكرو جديد  للتعديل عليه وكيفية تصدير واستيراد الماكرو

انا اعلم ان ملف الماكرو يكون bas لكن بدور على فيديو لتصدير الماكرو او استيراده لكن لم افلح

اخيرا تقبل خالص تحياتى

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

أخي الحبيب ..كود مسح البيانات غير كود الاستبدال .. لا تخلط الأمور ..هذا كود .. وذلك كود آخر

وقد أرفقتهما في مشاركة . وكل كود لوحده

بالنسبة لاستيراد الكود لا داعي لكل ما تقوله ..

افتح ملفك اللي محتاج تدرج الكود فيه ..

ادخل على محرر الأكواد Alt+ F11

 هتلاقي قايمة اسمها Insert اختار منها Module

انسخ الكود والصقه داخل الموديول ..

ومتنساش تحفظ الملف بصيغة xlsm حتى يتم الاحتفاظ بالأكواد ..

لو تعثرت ستجدنا بجانبك إن شاء الله

[mr.mohamed2]

الف شكر يا استاذ ياسر وتقبل الله اعمالك

طبعا اذا احتجت شيئ هسال حضرتك

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

أخي الفاضل

جرب الكود بهذا الشكل :

Sub ClearSpeicific()
    Dim Cell As Range
    Application.ScreenUpdating = False
        For Each Cell In Range("A4:Z" & Cells(Rows.Count, 1).End(xlUp).Row)
            On Error Resume Next
            If Cell.Value = "ــ" Or Cell.Value = "ــــــ" Or Cell.Value = "*" Or Cell.Value = "//" Or Cell.Value = "لا يوجد" Then Cell.Value = ""
        Next Cell
    Application.ScreenUpdating = True
End Sub

وبعد إذنك بلاش رسائل خاصة ..قم بالمشاركة في الموضوع ، هذا لأنني أنسى الموضوعات أساسا التي شاركت فيها ..

كل ما عليك أن تطرح مشكلتك الجديدة في المنتدى ، ليقوم بمساعدتك من لديه الوقت والعلم ، وأنا مش هبخل عليك في المرة التانية .. مبخلتش عليك في الأول يبقا مش هبخل عليك تاني (مش كدا ولا ايه)

[mr.mohamed2]

أخي الفاضل

جرب الكود بهذا الشكل :

Sub ClearSpeicific()
    Dim Cell As Range
    Application.ScreenUpdating = False
        For Each Cell In Range("A4:Z" & Cells(Rows.Count, 1).End(xlUp).Row)
            On Error Resume Next
            If Cell.Value = "ــ" Or Cell.Value = "ــــــ" Or Cell.Value = "*" Or Cell.Value = "//" Or Cell.Value = "لا يوجد" Then Cell.Value = ""
        Next Cell
    Application.ScreenUpdating = True
End Sub

وبعد إذنك بلاش رسائل خاصة ..قم بالمشاركة في الموضوع ، هذا لأنني أنسى الموضوعات أساسا التي شاركت فيها ..

كل ما عليك أن تطرح مشكلتك الجديدة في المنتدى ، ليقوم بمساعدتك من لديه الوقت والعلم ، وأنا مش هبخل عليك في المرة التانية .. مبخلتش عليك في الأول يبقا مش هبخل عليك تاني (مش كدا ولا ايه)

يا اخى جزاك الله خيرا

ثانيا انا اعلم انك لم تبخل واعلم انك احسنت وانا اقدر الاحسان جدا..... واقدر صنيعك

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

واعذرنى اذا كان تصرفي هذا ازعجك

تقبل خالص تحياتى

[mr.mohamed2]

اخى الكريم بفضل ربي الكود يعمل جيد جدا

تقبل تحياتى وجزاك الله خيراً

وبجد انت راجل محترم وتساعد الاخرين

بارك الله فى علمك وزادك منه

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

بارك الله فيك يا مستر محمد

وفي انتظار المزيد من طلباتك المفيدة والجديدة ، وفي انتظار أيضاً مساهماتك الفعالة في المنتدى (كن معطاءاً .. عندها ستستفيد أكثر مما تفيد) : حكمة اليوم