الأربعاء، 19 يناير 2022
  1 الردود
  8.4 ألف زيارة
0
الأصوات
فك
عزيزي جميع

إذا كان لدي الصف n (عدد كبير جدًا). أريد حساب التكرارات لكل 10 خلايا. على سبيل المثال

على سبيل المثال لدي المجموعة التالية
2
1
1
1
1
1
1
3
2

أحتاج إلى حساب التكرارات (مع مراعاة التكرار الأول) ، كل 3 خلايا ، أي يجب أن يكون الناتج
2
1
3


أي اقتراحات
شكرا مقدما. 
منذ سنوات 2
·
#2441
0
الأصوات
فك
مرحبا متورنادو ،

لإزالة قيم إزالة كل 10 خلايا ، يرجى القيام بما يلي:

  1. في ورقة العمل الخاصة بك ، اضغط على قديم + F11، ثم اضغط إدراج > وحدة;
  2. انسخ الكود أدناه ، والصقه في مربع الوحدة النمطية ؛
  3. صحافة F5 لتشغيل الكود ، فسترى ملف كوتولس ل إكسيل مربع الحوار كما هو موضح أدناه:
  4.   مربع الحوار. png
  5. ارجع إلى ورقة العمل الخاصة بك ، وحدد النطاق. ثم انقر فوق ملف OK buttom على الحوار.


Sub RemoveDuplicatesValue_10()

Dim xSltRg, xCells, xRg As Range
Dim xStartRg, xEndRg As Range
Dim xSInt, xCount, xRntInt, xNumInt, xF As Integer
On Error Resume Next

xSInt = 10
Set xSltRg = Application.InputBox("Select range:", "Kutools for Excel", , , , , , 8)
If xSltRg Is Nothing Then Exit Sub
Set xSltRg = Application.Intersect(ActiveSheet.UsedRange, xSltRg)
Set xSltRg = Application.Union(xSltRg, xSltRg.Item(1))
xCount = xSltRg.Count
xNumInt = Int(xCount / xSInt)
xRntInt = 0
xRntInt = xCount Mod xSInt
For xF = 1 To xNumInt
Set xStartRg = xSltRg.Item(((xF - 1) * xSInt + 1))
Set xEndRg = xSltRg.Item(xF * xSInt)
Set xCells = xSltRg.Worksheet.Range(xStartRg.AddressLocal & ":" & xEndRg.AddressLocal)
For xInt = xCells.Count To 1 Step -1
Set xRg = xCells.Item(xInt)
If WorksheetFunction.CountIf(xCells, xRg.Value) > 1 Then
xRg.Value = ""
End If
Next
Next
If xRntInt > 0 Then
Set xStartRg = xSltRg.Item(xNumInt * xSInt + 1)
Set xEndRg = xSltRg.Item(xCount)
Set xCells = xSltRg.Worksheet.Range(xStartRg.AddressLocal & ":" & xEndRg.AddressLocal)
For xInt = xCells.Count To 1 Step -1
Set xRg = xCells.Item(xInt)
If WorksheetFunction.CountIf(xCells, xRg.Value) > 1 Then
xRg.Value = ""
End If
Next
End If

End Sub


لاحظ أنه لإزالة القيم المكررة كل N خلايا ، قم بتغيير 10 في الكود إلى N.

أماندا
المرفقات (1)
  • الصفحة:
  • 1
لا توجد ردود لهذا المنصب حتى الآن.