بسم الله والحمد لله والصلاةوالسلام على رسول الله
(اليوم هتكلم عن كود يهدف الى توحيد الكلمات التى لها نفس الغرض لأجل تخفيف العبئ فى تحليل البيانات)
بعد ادخال بيانات بأعداد ضخمه فمثلا الى 50,000 صف ثم لاحظت فى الاخير اختلافات فى المسميات لغرض واحد
فلما نيجى نطلع تقرير بالمسميات الفريده لاسماء شركات مثلا
مش هيطلعوا حاجه واحده بسبب اختلاف حروف زى حرف الياء او مسافات او ..... الى اخره
مثلا الصفوف دى:
اسم الشركة المديونيات
العربى للتكييفات الحديثة 400
العربي للتكييفات الحديثه 500
العربى للتكييفات الحديثه 400
العربي للتكييفات الحديثة 550
لما العدد يبقى ضخم ونكتشف الامر فى الاخر المعالجة وقتها هتكون اشبه بالمستحيل بشكل يدوى
فسريعا سريعا زى ما قولت انسخ الكود دا عندك فى نافذة الاكواد داخل موديول
CODE
Sub Switch_first()
'Developer: Eslam Abdullah
Dim o$, n$, x&, y%, rng: rng = Selection
o = InputBox("Enter the old char (?)", "Switch first character")
If StrPtr(o) = 0 Then GoTo ext Else If Len(o) <> 1 Then GoTo msg
n = InputBox("Enter the new char (?)", "Switch first character")
If StrPtr(n) = 0 Then GoTo ext Else If Len(n) <> 1 Then GoTo msg
With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = "(^|s)" & o
If Not IsArray(rng) Then ReDim rng(1 To 1, 1 To 1): rng(1, 1) = Selection
For x = 1 To UBound(rng, 1): For y = 1 To UBound(rng, 2)
rng(x, y) = LTrim(.Replace(rng(x, y), " " & n)): Next: Next
Selection = rng
End With
MsgBox "Done", 64, "Auditor: Eslam Abdullah"
ext: Exit Sub
msg: MsgBox "Only one char", 16, "Auditor: Eslam Abdullah"
End Sub
'-----------------------------------------------------------------------------
Sub Switch_last()
'Developer: Eslam Abdullah
Dim o$, n$, x&, y%, rng: rng = Selection
o = InputBox("Enter the old char (?)", "Switch last character")
If StrPtr(o) = 0 Then GoTo ext Else If Len(o) <> 1 Then GoTo msg
n = InputBox("Enter the new char (?)", "Switch last character")
If StrPtr(n) = 0 Then GoTo ext Else If Len(n) <> 1 Then GoTo msg
With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = o & "($|s)"
If Not IsArray(rng) Then ReDim rng(1 To 1, 1 To 1): rng(1, 1) = Selection
For x = 1 To UBound(rng, 1): For y = 1 To UBound(rng, 2)
rng(x, y) = RTrim(.Replace(rng(x, y), n & " ")): Next: Next
Selection = rng
End With
MsgBox "Done", 64, "Auditor: Eslam Abdullah"
ext: Exit Sub
msg: MsgBox "Only one char", 16, "Auditor: Eslam Abdullah"
End Sub
'-----------------------------------------------------------------------------
Sub Trim_Spaces()
'Developer: Eslam Abdullah
Dim x&, y%, rng: rng = Selection
If Not IsArray(rng) Then ReDim rng(1 To 1, 1 To 1): rng(1, 1) = Selection
For x = 1 To UBound(rng, 1): For y = 1 To UBound(rng, 2)
rng(x, y) = Application.Trim(rng(x, y)): Next: Next
Selection = rng
MsgBox "Done", 64, "Auditor: Eslam Abdullah"
End Sub
ما هذا ، هذا ماذا
هذا هاخد الاسماء اللى قولتها فوق دى عندى فى شيت اكسيل كمثال
هحدد الخلايا اللى عايز اظبطها
ثم اضغط اختصار Alt+ F8
على طول هيظهر فورم فيه 3 اوامر منتظرين اوامر حضرتك وهما :
Switch_first : ودا عشان توحد اول حرف من كل كلمة فى النطاق المحدد
Switch_last : ودا عشان توحد اخر حرف من كل كلمة فى النطاق المحدد
Trim_Spaces : ودا عشان توحد المسافات الزائدة وتعملهم Trim
زى الصورة دى كدا
حلو قول حلو ، طيب تمام
نجرب تانى واحدة كدا ونحدد النطاق ونضغط على Switch_last ونقوله Run ياحاج (متنساش ياحاج دى مهمة أوى)
هيطلب منك الحرف القديم نقولة مثلاً ي
وهيطلب منك الحرف الجديد نقولة مثلاً ى
هوبا كل الكلمات اللى كانت بتنتهى بحرف ي أصبحت بتنتهى بحرف ى شوفت سهله ازاى
نفس الخطوات مع Switch_first لكن التغيير هيكون فى بداية الكلمة وبس كدا
ولما تضغط Run على Trim_Spaces دا مش هيطلب حاجه طريقه صحراوى هيعمل Trim لكلوا دفعه واحده
الهدف من الاوامر الظريفه اللطيفه دى هو توحيد حروف ومسافات اثناء ادخال البيانات
لاى سبب ممكن تكون اخدت البيانات دى من مصدر تانى وملكش ايد فيها وممكن ضعف فى النظام او سهو وقت التصميم او مدفعتش للحاج عبده البقال حق كيس الشيبسى
اياً كان المهم حصل فى نهاية المطاف انك محتاج طريقة لتوحيد تلك الاختلافات للوصول لنتيجة دقيقة
من هنا دى ادوات مساعدة لانقاذ الموقف ومن هنا برضوا اقول لكم من هذا المسرح العريض مسرح الصقر ذو العيون الثاقبة
[مرفق ملف عمل مع العلم أنه تم تحديث الملف بكود إضافى موضح بداخله]
أراكم بخير المرة القادمة إن شاء الله ، دمتم بخير اخوانى الأعزاء
كان معكم أخوكم فى الله إسلام عبدالله والسلام عليكم ورحمة الله وبركاته