spyhearts قام بنشر يونيو 22 مشاركة قام بنشر يونيو 22 السلام عليكم ورحمه الله وبركاته كل عام وحضراتكم بخير محتاج مساعدة في الملف المرفق فضلا وليس امرا ولكم جزيل الشكر والتقدير atf.xlsb رابط هذا التعليق شارك More sharing options...
Saleh Ahmed Rabie قام بنشر يونيو 22 مشاركة قام بنشر يونيو 22 5 ساعات مضت, spyhearts said: السلام عليكم ورحمه الله وبركاته كل عام وحضراتكم بخير محتاج مساعدة في الملف المرفق فضلا وليس امرا ولكم جزيل الشكر والتقدير atf.xlsb 68.31 kB · 6 downloads وعليكم السلام ورحمة الله وبركاته **كود VBA لفصل محتوى الخلية إلى جزئين (الوصف والكود):** Sub SplitCellContent() Dim rng As Range Dim arrContent() As String Dim strDescription As String Dim strCode As String ' تحديد الخلية التي تحتوي على المحتوى الذي تريد فصله Set rng = Range("A2") ' تقسيم المحتوى إلى مصفوفة من السلاسل arrContent = Split(rng.Value, " ") ' استخراج الوصف والكود من المصفوفة strDescription = arrContent(0) strCode = arrContent(1) ' وضع الوصف والكود في خلايا منفصلة rng.Offset(0, 1).Value = strDescription rng.Offset(0, 2).Value = strCode End Sub **مثال:** إذا كان محتوى الخلية A2 هو: جهاز كمبيوتر محمول HP EliteBook 840 G8 فسيؤدي تشغيل كود VBA هذا إلى فصل المحتوى إلى الخليتين B2 وC2 على النحو التالي: * **B2:** جهاز كمبيوتر محمول HP EliteBook 840 G8 * **C2:** 840 G8 **ملاحظة:** * يمكنك تعديل كود VBA لتناسب احتياجاتك الخاصة، مثل تغيير الخلية التي تحتوي على المحتوى أو تغيير الفاصل المستخدم لفصل الوصف والكود. * يمكنك أيضًا استخدام كود VBA لفصل محتوى الخلية إلى أكثر من جزئين. 1 رابط هذا التعليق شارك More sharing options...
spyhearts قام بنشر يونيو 22 الكاتب مشاركة قام بنشر يونيو 22 53 دقائق مضت, Saleh Ahmed Rabie said: وعليكم السلام ورحمة الله وبركاته **كود VBA لفصل محتوى الخلية إلى جزئين (الوصف والكود):** Sub SplitCellContent() Dim rng As Range Dim arrContent() As String Dim strDescription As String Dim strCode As String ' تحديد الخلية التي تحتوي على المحتوى الذي تريد فصله Set rng = Range("A2") ' تقسيم المحتوى إلى مصفوفة من السلاسل arrContent = Split(rng.Value, " ") ' استخراج الوصف والكود من المصفوفة strDescription = arrContent(0) strCode = arrContent(1) ' وضع الوصف والكود في خلايا منفصلة rng.Offset(0, 1).Value = strDescription rng.Offset(0, 2).Value = strCode End Sub **مثال:** إذا كان محتوى الخلية A2 هو: جهاز كمبيوتر محمول HP EliteBook 840 G8 فسيؤدي تشغيل كود VBA هذا إلى فصل المحتوى إلى الخليتين B2 وC2 على النحو التالي: * **B2:** جهاز كمبيوتر محمول HP EliteBook 840 G8 * **C2:** 840 G8 **ملاحظة:** * يمكنك تعديل كود VBA لتناسب احتياجاتك الخاصة، مثل تغيير الخلية التي تحتوي على المحتوى أو تغيير الفاصل المستخدم لفصل الوصف والكود. * يمكنك أيضًا استخدام كود VBA لفصل محتوى الخلية إلى أكثر من جزئين. السلام عليكم ورحمه الله وبركاته مشكور ا. صالح ولكن لم يظبط معي الكود بانتظار المساعدة رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يونيو 22 مشاركة قام بنشر يونيو 22 هل هده هي النتيجة المتوقعة 1 رابط هذا التعليق شارك More sharing options...
spyhearts قام بنشر يونيو 22 الكاتب مشاركة قام بنشر يونيو 22 1 دقيقه مضت, محمد هشام. said: هل هده هي النتيجة المتوقعة تمام ا. محمد هذه هي النتيجة المطلوبة رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يونيو 22 مشاركة قام بنشر يونيو 22 ادن يمكنك استخدام الصيغ على النحو التالي ' الوصف =LEFT(A2,SEARCH("-",A2)-1) 'or =LEFT(A2,FIND("-",A2)-1) 'الكود =MID(A2,FIND("-",A2)+1,LEN(A2)) 'or =RIGHT(A2,LEN(A2)-SEARCH("-",A2)) 'or =MID(A2,FIND("-",A2)+1,100) مع سحب المعادلة للاسفل atf v2.xlsb 1 رابط هذا التعليق شارك More sharing options...
spyhearts قام بنشر يونيو 22 الكاتب مشاركة قام بنشر يونيو 22 (معدل) 26 دقائق مضت, محمد هشام. said: ادن يمكنك استخدام الصيغ على النحو التالي ' الوصف =LEFT(A2,SEARCH("-",A2)-1) 'or =LEFT(A2,FIND("-",A2)-1) 'الكود =MID(A2,FIND("-",A2)+1,LEN(A2)) 'or =RIGHT(A2,LEN(A2)-SEARCH("-",A2)) 'or =MID(A2,FIND("-",A2)+1,100) مع سحب المعادلة للاسفل atf v2.xlsb 72.99 kB · 0 downloads شكرا ا. محمد مبدع كالعادة يعجز لساني عن كتابة وصف ومدح حضرتك في مساعدة الاعضاء يليق بافكار حضرتك عن تجربة شخصية في الحلول هل يمكن فضلا من حضرتك وضعها كود برمجي تم تعديل يونيو 22 بواسطه spyhearts تعديل رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يونيو 22 مشاركة قام بنشر يونيو 22 بما انني غير متاكد من مكان وضع النتائج اليك اسهل طريقة لتتمكن من تعديلها على حسب احتياجاتك Sub ExtractFromText() Dim lr& Set ws = Sheets("ATIF") Application.ScreenUpdating = False ws.Range("b2:c" & ws.Rows.Count).ClearContents lr = ws.Cells(Rows.Count, "A").End(xlUp).Row With ws.Range("B2:B" & lr) .Formula = "=LEFT(A2,FIND(""-"",A2)-1)" .Value = .Value With ws.Range("C2:C" & lr) .Formula = "=MID(A2,FIND(""-"",A2)+1,LEN(A2))" .Value = .Value End With End With Application.ScreenUpdating = True End Sub 1 رابط هذا التعليق شارك More sharing options...
spyhearts قام بنشر يونيو 22 الكاتب مشاركة قام بنشر يونيو 22 شكرا ا. محمد جزاك الله كل خير تم تشغيل الكود بنجاح شاكر جدا لحضرتك واتمني لحضرتك كل الخير من نجاح الى نجاح باذن الله رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر يونيو 22 أفضل إجابة مشاركة قام بنشر يونيو 22 (معدل) 48 دقائق مضت, spyhearts said: تم تشغيل الكود بنجاح يسعدنا اننا استطعنا مساعدتك ادن اليك حل اخر في حالة عدم الرغبة باستخدام المعادلات Sub ExtractFromText2() Dim arr() As String, Cell As Range, i As Integer, lr& Set WS = Sheets("ATIF") Application.ScreenUpdating = False WS.Range("b2:C" & WS.Rows.Count).ClearContents lr = WS.Cells(Rows.Count, "A").End(xlUp).Row For Each Cell In Range("A2:A" & lr) arr = Split(Trim(Cell), "-") If UBound(arr) <> 0 Then For i = 0 To UBound(arr) Cell.Offset(, i + 1) = arr(i) Next End If Next Application.ScreenUpdating = True End Sub '*********OR*********** Sub ExtractFromText3() Dim r As Range, lr& Set WS = Sheets("ATIF") Application.ScreenUpdating = False With WS .Range("B2:C" & .Rows.Count).ClearContents lr = .Cells(Rows.Count, "A").End(xlUp).Row For Each r In Range("A2:A" & lr) .Range(r.Offset(0, 1), r.Offset(0, 2)).Value = Split(r, "-") Next r End With Application.ScreenUpdating = True End Sub تم تعديل يونيو 22 بواسطه محمد هشام. 3 رابط هذا التعليق شارك More sharing options...
spyhearts قام بنشر يونيو 22 الكاتب مشاركة قام بنشر يونيو 22 34 دقائق مضت, محمد هشام. said: يسعدنا اننا استطعنا مساعدتك ادن اليك حل اخر في حالة عدم الرغبة باستخدام المعادلات Sub ExtractFromText2() Dim arr() As String, Cell As Range, i As Integer, lr& Set WS = Sheets("ATIF") Application.ScreenUpdating = False WS.Range("b2:C" & WS.Rows.Count).ClearContents lr = WS.Cells(Rows.Count, "A").End(xlUp).Row For Each Cell In Range("A2:A" & lr) arr = Split(Trim(Cell), "-") If UBound(arr) <> 0 Then For i = 0 To UBound(arr) Cell.Offset(, i + 1) = arr(i) Next End If Next Application.ScreenUpdating = True End Sub '*********OR*********** Sub ExtractFromText3() Dim r As Range, lr& Set WS = Sheets("ATIF") Application.ScreenUpdating = False With WS .Range("B2:C" & .Rows.Count).ClearContents lr = .Cells(Rows.Count, "A").End(xlUp).Row For Each r In Range("A2:A" & lr) .Range(r.Offset(0, 1), r.Offset(0, 2)).Value = Split(r, "-") Next r End With Application.ScreenUpdating = True End Sub بارك الله فيك وزادك من علمه ا. محمد تسلم ايديك رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان