اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search
أبوســـارة1973

تمت الإجابة فرز قيم في نطاق محدد مع حذف القيم المكررة

Recommended Posts

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

في الملف المرفق مطلوب فرز القيم الموجودة في النطاق z8:bm8 

في النطاق f8:y8

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

وعدم الالتفات إلى القيم الأخرى مثل كلمة اجتماع أو كلمة راحة أو أي كلمة أخرى لا ينطبق عليها الشرط 

ثم مطلوب ترتيب القيم في النطاق 

f8:y8

ترتيباً تصاعدياً 

وهكذا في بقية الأسطر حتى السطر رقم 95

Book_11.xlsx

شارك هذه المشاركه


رابط المشاركه
شارك

ربما ينفع هذا الماكرو

Option Explicit

Sub Test_Mots()
Dim Sh As Worksheet
Dim Ro%, i%, X%, m%
Dim arr()
Set Sh = Sheets("Sheet1")
Ro = Sh.Cells(Rows.Count, "E").End(3).Row
Sh.Range("F8:Y" & Ro).ClearContents
 For X = 8 To Ro
  For i = 26 To 65
        If Sh.Cells(X, i) Like "#?#" Then
          ReDim Preserve arr(m)
           arr(m) = Sh.Cells(X, i)
           m = m + 1
         End If
  Next i
    If m > 0 Then
       Sh.Cells(X, "F").Resize(, m) = arr
    End If

    Erase arr: m = 0
  Next X
  
End Sub

الملف مرفق

Abou_sara.xlsm

  • Like 1
  • Thanks 1

شارك هذه المشاركه


رابط المشاركه
شارك

 و هذا الماكرو يوم بترتيب العناصر ابجدياً

Option Explicit

Sub Test_Mots_sorted()
Dim Sh As Worksheet
Dim Ro%, i%, X%
Dim KK As Object
Set Sh = Sheets("Sheet1")
Ro = Sh.Cells(Rows.Count, "E").End(3).Row
Sh.Range("F8:Y" & Ro).ClearContents
Set KK = CreateObject("System.Collections.Arraylist")
 For X = 8 To Ro
  For i = 26 To 65
        If Sh.Cells(X, i) Like "#?#" Then
         KK.Add Sh.Cells(X, i).Value
        End If
  Next i
  If KK.Count Then
    KK.Sort
    Sh.Cells(X, "F").Resize(, KK.Count) = KK.toarray
    KK.Clear
   End If

  Next X
  
End Sub

الملف من جديد

Abou_sara_sorted.xlsm

  • Like 1
  • Thanks 1

شارك هذه المشاركه


رابط المشاركه
شارك

شكراً جزيلا أستاذنا الكبير 

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

والمطلوب هو ذكر القيمة مرة واحدة فقط ، فلو تكررت مثلاً القيمة 

1B1

في النطاق 

Z8:BM8 

أكثر من مرة يقوم الكود بتسجيلها في النطاق 

Ff8:Y8

مرة واحدة فقط 

شارك هذه المشاركه


رابط المشاركه
شارك

تم التعديل على الملف كما تريد

Option Explicit

Sub Test_Mots_sorted()
Dim Sh As Worksheet
Dim Ro%, i%, X%
Dim KK As Object
Set Sh = Sheets("Sheet1")
Ro = Sh.Cells(Rows.Count, "E").End(3).Row
Sh.Range("F8:Y" & Ro).ClearContents
Set KK = CreateObject("System.Collections.Arraylist")
 For X = 8 To Ro
  For i = 26 To 65
        If Sh.Cells(X, i) Like "#?#" Then
         If Not KK.Contains(Sh.Cells(X, i).Value) Then
             KK.Add Sh.Cells(X, i).Value
         End If
        End If
  Next i
  If KK.Count Then
    KK.Sort
    Sh.Cells(X, "F").Resize(, KK.Count) = KK.toarray
    KK.Clear
   End If

  Next X
  
End Sub

 

Abou_sara_sorted_Uniq.xlsm

  • Like 2

شارك هذه المشاركه


رابط المشاركه
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


  • المتواجدين الان   0 اعضاء متواجدين الان

    لايوجد اعضاء مسجلون يتصفحون هذه الصفحه

×
×
  • اضف...