فصل محتوى الخلية إلى جزئين

spyhearts · يونيو 22

السلام عليكم ورحمه الله وبركاته

كل عام وحضراتكم بخير

محتاج مساعدة في الملف المرفق فضلا وليس امرا

ولكم جزيل الشكر والتقدير

Saleh Ahmed Rabie · يونيو 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 لفصل محتوى الخلية إلى أكثر من جزئين.

spyhearts · يونيو 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 لفصل محتوى الخلية إلى أكثر من جزئين.

السلام عليكم ورحمه الله وبركاته

مشكور ا. صالح ولكن لم يظبط معي الكود

بانتظار المساعدة

**محمد هشام.** · يونيو 22

هل هده هي النتيجة المتوقعة

img?id=853965

spyhearts · يونيو 22

1 دقيقه مضت, محمد هشام. said:

هل هده هي النتيجة المتوقعة

تمام ا. محمد

هذه هي النتيجة المطلوبة

**محمد هشام.** · يونيو 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

spyhearts · يونيو 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
تعديل

**محمد هشام.** · يونيو 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

spyhearts · يونيو 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 بواسطه محمد هشام.

spyhearts · يونيو 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

بارك الله فيك وزادك من علمه ا. محمد

تسلم ايديك

تسجيل الدخول

فصل محتوى الخلية إلى جزئين

الردود الموصى بها

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

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

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

Important Information