اذهب الي المحتوي
أوفيسنا

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


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

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

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

في الملف المرفق مطلوب فرز القيم الموجودة في النطاق 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 اعضاء متواجدين الان

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

Important Information