abouelhassan

جرب

Sub ProcessData()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow As Long, i As Long
    Dim officeName As String, dateValue As String, claimNumber As String
    Dim uniqueOffices As New Collection
    Dim officeDates As New Dictionary
    Dim officeClaims As New Dictionary
    
    ' Set references to the worksheets
    Set ws1 = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to the actual name of your worksheet
    Set ws2 = ThisWorkbook.Sheets("Sheet2") ' Change "Sheet2" to the actual name of your worksheet
    
    ' Find the last row in worksheet 1
    lastRow = ws1.Cells(ws1.Rows.Count, "O").End(xlUp).Row
    
    ' Loop through the data in worksheet 1
    For i = 1 To lastRow
        ' Get the office name
        officeName = ws1.Cells(i, "O").Value
        ' Add the office name to the uniqueOffices collection
        On Error Resume Next
        uniqueOffices.Add officeName, CStr(officeName)
        On Error GoTo 0
        ' Get the date value
        dateValue = CStr(ws1.Cells(i, "P").Value)
        ' Get the claim number
        claimNumber = CStr(ws1.Cells(i, "Q").Value)
        ' Add the date and claim number to the dictionaries if they don't already exist
        If Not officeDates.Exists(officeName) Then
            officeDates.Add officeName, dateValue
            officeClaims.Add officeName, claimNumber
        ElseIf InStr(1, officeDates(officeName), dateValue) = 0 Then
            officeDates(officeName) = officeDates(officeName) & " + " & dateValue
        ElseIf InStr(1, officeClaims(officeName), claimNumber) = 0 Then
            officeClaims(officeName) = officeClaims(officeName) & " + " & claimNumber
        End If
    Next i
    
    ' Write the unique office names to worksheet 2
    Dim office As Variant
    Dim rowIndex As Long: rowIndex = 1
    For Each office In uniqueOffices
        ws2.Cells(rowIndex, 1).Value = office
        ' Write the dates for each office
        ws2.Cells(rowIndex, 2).Value = officeDates(office)
        ' Write the claim numbers for each office
        ws2.Cells(rowIndex, 3).Value = officeClaims(office)
        rowIndex = rowIndex + 1
    Next office
    
    MsgBox "Process complete."
    
End Sub

يرجى تغيير اسمي الورقتين "Sheet1" و "Sheet2" إلى الأسماء الفعلية للورقتين الخاصتين بك.

تفضل

abouelhassan.xls

انا قمت بالتنفيذ على التكرار فى اسم المكتب فتحت الملف لم افهم شئ اخى  وضح المطلوب تفصيلى هل المطلوب عدم تكرار التاريخ ام المطالبة ام جمعهم

هذا كل ما استطيع تقديمه اخى الكريم

طيب ايه المطلوب تفصيلا فى الملف الذى ارسلته لك اخى الكريم

انا نفذت الموجود بالملف المرفق

محاولة لعلها تفيد

function onEdit(e) {
  var sheet = e.source.getActiveSheet();
  var range = e.range;
  
  // Check if edited range is in columns A-F
  if (range.getColumn() >= 1 && range.getColumn() <= 6) {
    var row = range.getRow();
    
    // Check if column H in the edited row is empty
    if (!sheet.getRange(row, 8).getValue()) {
      // Generate a random number and set it in column H
      var randomNum = Math.floor(Math.random() * 1000) + 1;
      sheet.getRange(row, 8).setValue(randomNum);
    }
  }
}

هذا الكود يعمل على تطبيق رقم عشوائي في العمود H عند تعبئة البيانات في الأعمدة A-F. يجب وضع هذا الكود في محرر النصوص في Google Apps Script وحفظه. بعد ذلك، سيتم تنفيذ الكود تلقائيًا عند تعديل البيانات في الأعمدة A-F.

تفضل طلبك

abouelhassan.xlsm

ما هو المطلولب تفصيلى اخى لانى فتحت الملف وما فهمت المطلوب

تفضل

Counter1.xls

جرب

=IF(G2=K2,"01-01-2000",IF(K2+L2<G2,"01-01-2030",INDEX($D$5:$D$10307,SMALL(IF(($A$5:$A$10307=E2)*($C$5:$C$10307>=SUMIF($E$2:E2,E2,$L$2:L2)),ROW($A$5:$A$10307)-ROW($A$5)+1),2)-5)))

الدالة  دالة مصفوفة لتعمل

Ctrl + Shift + Enter لتنفيذها

جرب هذه

لحل هذه المشكلة، يمكنك استخدام وظيفة `INDEX` و `MATCH` في Excel للعثور على القيمة المطلوبة بناءً على الشروط التي حددتها. يمكنك استخدام الصيغة التالية في الخلية التي تريد أن تظهر فيها اسم المندوب:

=INDEX('شيت 1'!$B$2:$B$1000, MATCH(1, ('شيت 1'!$A$2:$A$1000=تاريخ)*('شيت 1'!$C$2:$C$1000=كود_الزبون), 0))

يرجى استبدال `'شيت 1'` بالاسم الصحيح للشيت الذي تحتوي عليه البيانات، وتغيير `$B$2:$B$1000` إلى النطاق الصحيح الذي تحتوي فيه أسماء المندوبين، وكذلك `$A$2:$A$1000` و `$C$2:$C$1000` بالنطاقات التي تحتوي على تواريخ وأكواد الزبائن على التوالي.

قم بتغيير `تاريخ` و `كود_الزبون` إلى مراجع للخلايا التي تحتوي على التاريخ وكود الزبون اللذين تبحث عنهما.

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

2 ساعات مضت, mustafa khatab said:

ممكن ملف الاكسل النتيجة تمنع التكرار ويكون ترتيب ابجدى .

 

ده سوال جديد افتح موضوع جديد اخى

سامحنى اخى مش فاهم طلبك 

انت طلبت فى البداية طلب والان طلب اخر غير واضح 

جرب

Sub DistributeSchools()
    Dim Teachers() As String
    Dim Schools As Integer
    Dim SchoolsPerTeacher As Integer
    Dim TotalTeachers As Integer
    Dim RandomIndex As Integer
    Dim i As Integer
    Dim j As Integer
    
    Schools = 304
    SchoolsPerTeacher = 6
    TotalTeachers = 50 ' عدد المعلمين
    
    ReDim Teachers(1 To TotalTeachers)
    
    ' ملء المعلمين بترقيمهم
    For i = 1 To TotalTeachers
        Teachers(i) = "Teacher " & i
    Next i
    
    ' توزيع المدارس بين المعلمين
    For i = 1 To Schools
        RandomIndex = Int((TotalTeachers * Rnd) + 1)
        ' تأكد من أن المعلم لديه أقل من 6 مدارس بالفعل
        Do While Len(Teachers(RandomIndex)) > 0
            RandomIndex = Int((TotalTeachers * Rnd) + 1)
        Loop
        Teachers(RandomIndex) = Teachers(RandomIndex) & " - School " & i
    Next i
    
    ' طباعة النتائج
    For i = 1 To TotalTeachers
        Debug.Print Teachers(i)
    Next i
    
End Sub

انقر فوق الزر "تشغيل" Run أو اضغط على F5 لتشغيل البرنامج.

هذا الكود يقوم بتوزيع المدارس بين 50 معلمًا بحيث يحصل كل معلم على 6 مدارس بشكل عشوائي. يمكنك ضبط عدد المعلمين وعدد المدارس حسب احتياجاتك.

للحصول على نفس الوظيفة التي يقدمها الدالة UNIQUE في إصدارات أقدم من Office، يمكنك استخدام صيغة مصفوفة مجمعة مع دالة INDEX وMATCH. يمكنك استخدام الصيغة التالية كبديل للدالة UNIQUE:
=IFERROR(INDEX($A$1:$A$10, MATCH(0, COUNTIF($B$1:B1, $A$1:$A$10) + IF($A$1:$A$10="", 1, 0), 0)), "")
```
في هذا المثال، يجب تغيير `$A$1:$A$10` إلى نطاق البيانات الخاص بك. ويجب وضع هذه الصيغة في الخلية B1، ثم سحبها لأسفل للحصول على القيم الفريدة من النطاق الأصلي في الخلية A1:A10.

تعديل

Sub KeepFirstWordOnly()
    Dim cell As Range
    Dim words() As String
    Dim i As Integer
    
    For Each cell In Range("A1:A10") ' تغيير النطاق حسب الحاجة
        words = Split(cell.Value, " ")
        If UBound(words) >= 0 Then ' التحقق من أن المصفوفة غير فارغة
            cell.Value = words(0)
        Else
            cell.Value = ""
        End If
    Next cell
End Sub

في 14‏/2‏/2024 at 09:04, بلانك said:

عفوا من الاساتذة الغالبية نستخدم اوفيس 2010 وهذة الدالة غير موجودة به فما العمل؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟ظ

جرب

=IFERROR(MID($A$1,ROW()-ROW($A$1)+1,1),"")

=

=TRANSPOSE(A1:A5)

 (TRANSPOSE) في جميع إصدارات إكسل بدءًا من إكسل 2007 

وبدون معادلات

1. قم بإنشاء جدول في ورقة العمل الخاصة بك بالأرقام التي ترغب في تحويلها.
2. حدد المجموعة من الأرقام التي ترغب في تحويلها.
3. انسخ المجموعة المحددة.
4. انتقل إلى الخلية الأولى في العمود الذي ترغب في وضع الأرقام فيه.
5. انقر بزر الماوس الأيمن واختر "تحويل" من قائمة الخيارات المتاحة.
6. ستظهر نافذة "تحويل"، انقر على "الصق القيمة فقط" ثم انقر على "موافق".

بهذه الطريقة، ستتم تحويل الأرقام من صفوف إلى أعمدة في إكسل. يمكنك تكرار هذه الخطوات لتحويل المزيد من الأرقام إذا لزم الأمر.

جرب

Sub KeepFirstWordOnly()
    Dim cell As Range
    Dim words() As String
    Dim i As Integer
    
    For Each cell In Range("A1:A10") ' تغيير النطاق حسب الحاجة
        words = Split(cell.Value, " ")
        cell.Value = words(0)
    Next cell
End Sub

هذا الكود يفترض أن الكلمات مفصولة بمسافة. إذا كانت الكلمات مفصولة بفاصلة أو حرف آخر، يجب تغيير الجزء `Split(cell.Value, " ")` ليناسب الفاصلة الصحيحة، على سبيل المثال، `Split(cell.Value, ",")` للكلمات المفصولة بفاصلة.

اليك الطريقه اخى الكريم جرب لإضافة مربع بحث للبحث عن الأصناف في ورقة العمل، يمكنك اتباع الخطوات التالية:

1. **إنشاء مربع حوار بحث:**

   - قم بالنقر على "مطور" في شريط الأدوات، ثم اختر "إدراج" واختر "زر التحكم".

   - ارسم مربعًا على الورقة ليكون زر البحث.

   - انقر بزر الماوس الأيمن على الزر الذي أنشأته واختر "تعيين معرف" لإعطاء الزر اسمًا مثل "btnSearch".

2. **إضافة الكود VBA للبحث:**

   - انقر بزر الماوس الأيمن على ورقة العمل واختر "عرض الكود".

   - استخدم الكود التالي لإنشاء نافذة حوار للبحث عن الأصناف

Sub SearchItem()
    Dim wsInventory As Worksheet
    Dim rngItems As Range, cell As Range
    Dim searchItem As String
    
    ' تحديد ورقة العمل للبحث فيها
    Set wsInventory = ThisWorkbook.Sheets("اسم_ورقة_العمل")
    
    ' مربع حوار البحث
    searchItem = InputBox("ادخل اسم الصنف للبحث عنه:")
    
    ' البحث عن الصنف وعرض النتائج
    If searchItem <> "" Then
        Set rngItems = wsInventory.Range("E:E").Find(What:=searchItem, LookIn:=xlValues, LookAt:=xlWhole)
        If Not rngItems Is Nothing Then
            MsgBox "كود الصنف: " & rngItems.Offset(0, -1).Value & vbNewLine & "اسم الصنف: " & rngItems.Value, vbInformation, "نتائج البحث"
        Else
            MsgBox "لم يتم العثور على الصنف.", vbExclamation, "نتائج البحث"
        End If
    End If
End Sub

يرجى استبدال "اسم_ورقة_العمل" بالاسم الفعلي لورقة العمل التي تريد البحث فيها.

لم استطيع تحميل الملف ممكن تشرح المطلوب 

تفضل

1. افتح Excel وانقر على الخلية التي تريد فيها عرض الرقم العمودي.
2. استخدم المعادلة التالية:

=TEXTJOIN(CHAR(10),TRUE,MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1))
 

   حيث A1 هو موقع الخلية التي تحتوي على الرقم الذي تريد تحويله إلى شكل عمودي. تأكد من تغيير A1 بموقع الخلية الصحيحة إذا كان الرقم في موقع مختلف.
   
3. اضغط على Enter.

هذا سيعرض الرقم بشكل عمودي في الخلية المستهدفة.

3 ساعات مضت, ehabaf2 said:

يرحل الى sheet2 يرحل كل البيانات التى ينطبق عليها الشرط بنفس ترتيب الاعمدة الموجود فى sheet 2 

الف الف شكر لمرور حضرتك

 

ماهو الشرط اخى الكريم 

وضح اخى