عادل ابوزيد قام بنشر الإثنين at 16:39 مشاركة قام بنشر الإثنين at 16:39 السلام عليكم الملف يحتوى على فورم يقوم بالبحث والاضافة والتعديل والانتقال بين الصفوف حسب اختيارك للبيانات فى الليست بوكس .. المطلوب : هناك مشكلتين : الاولى : بيانات الليست بوكس غير متفقه مع بيانات الشيت ... ولقد اكتشفت السبب وهو ان عمود المسلسل مرتبط بالتاريخ بمعنى ان المسلسل يبدا من 1 مع بداية كل شهر ويوبنتهى بنهاية الشهر ثم يبدا من جديد ببداية شهر جديد وهكذا وبالتالى عندما يتم استدعاء البيانات فى الليست بوكس بيانات مسلسل مثلاً 18 فى شهر 8 للاسف هى بيانات شهر 7 ( بداية التسلسل شهر 7 فى العمود ) وبالتالى عند تحديد اىو بيان فى شهر 8 او 9 او 10 سيتم تحديد نظيره فى شهر 7 الثانية : تنسيق اعمدة التاريخ فى الليست بوكس و وتنسيق بيانات التيكست بوكس الخاصة بالتاريخ مطلوب تنسيقها كالآتى : يوم / شهر / سنة تعديل فورم.rar رابط هذا التعليق شارك More sharing options...
alliiia قام بنشر الإثنين at 18:52 مشاركة قام بنشر الإثنين at 18:52 وعليكم السلام ورحمة الله وبركاته تفضل مطلوبك وبالتوفيق تعديل فورم.7z رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر الإثنين at 19:02 مشاركة قام بنشر الإثنين at 19:02 (معدل) وعليكم السلام ورحمة الله تعالى وبركاته Option Compare Text Dim f, Rng, wsData() Private Sub UserForm_Initialize() Dim f As Worksheet, Rng As Range Dim wsData As Variant, i As Long Set f = Sheets("البداية") Set Rng = f.Range("C7:N" & f.Cells(f.Rows.Count, "E").End(xlUp).row) wsData = Rng.Value For i = LBound(wsData, 1) To UBound(wsData, 1) Dim j As Long For j = 2 To 11 If IsDate(wsData(i, j)) Then wsData(i, j) = Format(wsData(i, j), "yyyy/mm/dd") Next j Next i With ListBox1 .ColumnWidths = "35;70;65;100;110;65;70;75;70;70;70;100" .ColumnCount = 12: .Font.Size = 9: .Font.Name = "Mudir MT" .List = wsData End With With ComboBox1 .AddItem "رقم الملف": .AddItem "الفاحص": .AddItem "اسم المراجع" End With 'Code............. End Sub Private Sub ListBox1_Click() Dim i As Byte, Rng As Long Dim Colstar As Integer, ColEnd As Integer Dim ws As Worksheet: Set ws = Sheets("البداية") Colstar = 4: ColEnd = 14 If ListBox1.ListIndex = -1 Then MsgBox "يرجى اختيار صف من القائمة", vbExclamation Exit Sub End If For i = 0 To 11 If IsDate(ListBox1.Column(i)) Then Controls("TextBox" & i + 1).Value = Format(ListBox1.Column(i), "yyyy/mm/dd") Else Controls("TextBox" & i + 1).Value = ListBox1.Column(i) End If Next i TextBox15.Value = ListBox1.ListIndex + 1 Rng = ListBox1.ListIndex + 7 With ws .Activate .Range(.Cells(Rng, Colstar), .Cells(Rng, ColEnd)).Select End With End Sub تعديل فورم.rar تم تعديل الإثنين at 19:04 بواسطه محمد هشام. رابط هذا التعليق شارك More sharing options...
عادل ابوزيد قام بنشر الإثنين at 19:27 الكاتب مشاركة قام بنشر الإثنين at 19:27 السلام عليكم ورحمه الله وبركاته الاساتذة الافاضل اشكر شحصكم الكريم على الاستجابة لموضوعى واسمحوا لى بملاحظة الآتى : عند اختبار البرنامج بعد التعديل عند تنفيذ تعديل فى بيان خاص بشهر 9 مثلاً للاسف يتم تعديل المناظر له فى شهر 7 بمعنى تم اختيار المسلسل رقم 510 فى شهر 9 وتم تعديل البيان وعند الضغط على تعديل البيان .. تبين انه قام البرنامج بتعديل المسلسل رقم 510 فى شهر 7 كاملاً ولم يتم تعديل البيان المناظر له فى شهر 9 تقبلوا شكرى وتقديرى رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر الإثنين at 21:28 مشاركة قام بنشر الإثنين at 21:28 Function irow(ws As Worksheet, tmp As String) As Long Dim lastrow As Long, i As Long lastrow = ws.Cells(ws.Rows.Count, "E").End(xlUp).row For i = 7 To lastrow If ws.Cells(i, 5).Value = tmp Then irow = i Exit Function End If Next i irow = -1 End Function تعديل Private Sub CommandButton2_Click() Dim ws As Worksheet, linge As Long, i As Long Dim ColArr As Variant, arr() As Variant Set ws = ThisWorkbook.Sheets("البداية") Dim tmp As String: tmp = Me.TextBox3.Value If tmp = "" Then: MsgBox "الرجاء إدخال رقم الملف", vbExclamation, "خطأ": Exit Sub linge = irow(ws, tmp) If linge = -1 Then: MsgBox "رقم الملف غير موجود", vbExclamation, "خطأ": TextBox3.SetFocus: Exit Sub If MsgBox("هل أنت متأكد أنك تريد تعديل بيانات " & Me.TextBox4.Value & "؟", vbYesNo + vbQuestion, "تأكيد") = vbYes Then ColArr = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N") arr = Array(Me.TextBox1.Value, Me.TextBox2.Value, Me.TextBox3.Value, _ Me.TextBox4.Value, Me.TextBox5.Value, Me.TextBox6.Value, _ Me.TextBox7.Value, Me.TextBox8.Value, Me.TextBox9.Value, _ Me.TextBox10.Value, Me.TextBox11.Value, Me.TextBox12.Value) Application.ScreenUpdating = False For i = LBound(arr) To UBound(arr) If i <= UBound(ColArr) Then ws.Cells(linge, ColArr(i)).Value = arr(i) End If Next i UserForm_Initialize Application.ScreenUpdating = True MsgBox "تم تعديل البيانات بنجاح", vbInformation End If End Sub ترحيل Private Sub CommandButton1_Click() Dim ws As Worksheet, lastrow As Long Dim arr() As Variant, ColArr As Variant, tmp As String Set ws = ThisWorkbook.Sheets("البداية") lastrow = ws.Cells(ws.Rows.Count, "E").End(xlUp).row tmp = Me.TextBox3.Value If tmp = "" Then MsgBox "الرجاء إدخال رقم الملف", vbExclamation, "خطأ": Exit Sub If TextBox4.Value = "" Then MsgBox "يرجى ادخال اسم صاحب المعاش", vbExclamation: TextBox4.SetFocus: Exit Sub If TextBox6.Value = "" Then MsgBox "يرجى ادخال اسم الفاحص", vbExclamation: TextBox6.SetFocus: Exit Sub If WorksheetFunction.CountIf(ws.Range("E7:E" & lastrow), tmp) > 0 Then MsgBox "رقم الملف موجود بالفعل", vbExclamation, "تكرار رقم الملف": Exit Sub End If ColArr = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N") arr = Array(Me.TextBox1.Value, Me.TextBox2.Value, tmp, TextBox4.Value, _ Me.TextBox5.Value, TextBox6.Value, Me.TextBox7.Value, _ Me.TextBox8.Value, Me.TextBox9.Value, Me.TextBox10.Value, _ Me.TextBox11.Value, Me.TextBox12.Value) Application.ScreenUpdating = False For i = LBound(arr) To UBound(arr) ws.Cells(lastrow + 1, ColArr(i)).Value = arr(i) Next i With ws.Range("C7:C" & ws.Cells(ws.Rows.Count, "D").End(xlUp).row) .Value = Evaluate("ROW(" & .Address & ")-6") End With For Each ctrl In Me.Controls If TypeName(ctrl) = "TextBox" Then ctrl.Value = "" Next ctrl UserForm_Initialize Application.ScreenUpdating = True MsgBox "تم إدخال البيانات بنجاح", vbInformation, "نجاح" End Sub تعديل فورم.rar 1 رابط هذا التعليق شارك More sharing options...
عادل ابوزيد قام بنشر الثلاثاء at 16:04 الكاتب مشاركة قام بنشر الثلاثاء at 16:04 (معدل) السلام عليكم ورحمه الله وبركاته من اعماق قلبى ارسل لكم اجمل الكلمات تعبيراً عن امتنانى وشكرى لمجهودكم ومساعدتكم لنا .. اسمح لى استاذى الفاضل ببعض الملاحظات منها التى استطعت التغلب عليها وقد قمت بوضعها بين سطرين ================ للتوضيح ومنها لم استطع ايجاد حل لها اولاً : الملاحظات المطلوب حل لها 1 - عند اجراء البحث تكون النتيجة حالة او اكثر عند الضغط عليها فى الليست بوكس يتم تحديد اول او ثانى صف فى الشيت حسب ترتيبه فى الليست بوكس وليس الصف المتواجد فيه نتيجة البحث فى الشيت 2 - عمود المسلسل اصبح مثل عمود الوارد من واحد حتى اخر رقم مسلسلى .. مع العلم انه المفروض يبدا من واحد مع كل بداية شهر بمعنى التاريخ فى اول الشهر يوليو يبدا المسلسل من 1 التاريخ فى ابو شهر اغسطس يبدا من 1 ... فإذا كان هذا هو المطلوب ولا يوجد بديل لذلك ، فأقترح ادخال عمود الوارد فى تنفيذ الكود مع عدم ظهوره فى الليست بوكس او عند تعديل البيانات حتى نحافظ على الهدف من وجود عمود المسلسل ثانياً : الملاحظات التى تم حلها .. برجاء مراجعتها حتى تتعارض مع اى اوامر اخرى داخل الكود 1 - مع كل اجراء تعديل فى البيانات لصف يتم تكرار بيانات الكمبوبوكس الموجوده فى جزء البحث 2 - عند الضغط على تفريغ خلية البحث يتم استعراض بيانات الشيت بدون التنسيقات المطلوبة والمرفق به حل للملاحظتين فقط تعديل فورم_بتعديل جزئى.rar تم تعديل الثلاثاء at 16:05 بواسطه عادل ابوزيد رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر الأربعاء at 05:27 مشاركة قام بنشر الأربعاء at 05:27 (معدل) 23 ساعات مضت, عادل ابوزيد said: رتيبه فى الليست بوكس وليس الصف المتواجد فيه نتيجة البحث فى الشيت Private Sub ListBox1_Click() Dim i As Byte, Clé As Variant Dim WS As Worksheet, ColF As Range Dim Colstar As Integer, ColEnd As Integer Set WS = Sheets("البداية") Colstar = 3 ColEnd = 14 For i = 0 To 11 Controls("TextBox" & (i + 1)).Value = IIf(ListBox1.ListIndex <> -1, ListBox1.Column(i), "") Next i Clé = TextBox4.Value Set ColF = WS.Columns("F").Find(What:=Clé, LookIn:=xlValues, LookAt:=xlWhole) If Not ColF Is Nothing Then WS.Activate WS.Range(WS.Cells(ColF.row, Colstar), WS.Cells(ColF.row, ColEnd)).Select End If End Sub 23 ساعات مضت, عادل ابوزيد said: مع كل اجراء تعديل فى البيانات لصف يتم تكرار بيانات الكمبوبوكس الموجوده فى جزء البحث With ComboBox1 .Clear .AddItem "رقم الملف": .AddItem "الفاحص": .AddItem "اسم المراجع" End With 23 ساعات مضت, عادل ابوزيد said: عند الضغط على تفريغ خلية البحث يتم استعراض بيانات الشيت بدون التنسيقات المطلوبة UserForm_Initialize TextBox13.Value = "": ComboBox1.Value = "" Label15.Caption = "" تعديل فورم.rar تم تعديل الأربعاء at 16:05 بواسطه محمد هشام. رابط هذا التعليق شارك More sharing options...
عادل ابوزيد قام بنشر الأربعاء at 10:32 الكاتب مشاركة قام بنشر الأربعاء at 10:32 السلام عليكم استاذى الفاضل .. اسمح لى بتوضيح الملحوظة الاولى بارسال صورتين مرة عدد نتائج البحث نتيحة واحدة والاخرى عدد نتائج البحث اكثر من نتيجة .. مع ملاحظة مكان التحديد فى الليست والشيت تقبل شكرى وامنتانى لمجهودكم الوفير واهتمامك رابط هذا التعليق شارك More sharing options...
عادل ابوزيد قام بنشر الأربعاء at 10:41 الكاتب مشاركة قام بنشر الأربعاء at 10:41 الملف المقتبس منه.xls رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر الأربعاء at 16:07 مشاركة قام بنشر الأربعاء at 16:07 (معدل) أعتدر أخي @عادل ابوزيد خطأ لم انتبه له😂 الكود ينفد طلبك لاكن يجب وضع قيمة البحث بعد الصف الخاص بنقل البيانات لعناصر التيكست بهدا الشكل ليس قبلها للتوضيح 1) الفكرة انه يقوم بتحديد الصف بناءا على قيمة textbox4 في عمود ( F ) اسم صاحب المعاش يمكنك تعديلها بما يناسبك For i = 0 To 11 Controls("TextBox" & (i + 1)).Value = IIf(ListBox1.ListIndex <> -1, ListBox1.Column(i), "") Next i Clé = TextBox4.Value 2) في حالة كانت لديك أسماء مكررة يمكنك اظافة شروط اخرى كما في المثال التالي بحيث سنعتمد على اسم صاحب المعاش و رقم الملف وعند التحقق من تطابق الشرطين سيتم تحديد الصف وفي حالة وجود تكرار لنفس البيانات سيقوم بتحديد جميع الصفوف المكررة يمكنك تحميل الملف في المشاركة السابقة بعد تصحيح الخطأ وإختيار ما يناسبك Private Sub ListBox1_Click() Dim ws As Worksheet, OnRng As Range, ColFind As Range Dim Colstar As Integer, ColEnd As Integer, n As Long Dim Clé As Variant, Clé2 As Variant, tmp As Range, f As String, i As Byte Set ws = Sheets("البداية") Colstar = 3: ColEnd = 14 For i = 0 To 11 Controls("TextBox" & (i + 1)).Value = ListBox1.Column(i) Next i TextBox15.Value = ListBox1.ListIndex + 1 Clé = TextBox4.Value: Clé2 = TextBox3.Value Set tmp = Nothing n = 0 Set OnRng = ws.Range(ws.Cells(7, "F"), ws.Cells(ws.Rows.Count, "F").End(xlUp)) Set ColFind = OnRng.Find(Clé, LookIn:=xlValues, LookAt:=xlWhole) If Not ColFind Is Nothing Then f = ColFind.Address Do If ws.Cells(ColFind.row, "E").Value = Clé2 Then n = n + 1 If tmp Is Nothing Then Set tmp = ColFind.EntireRow Else Set tmp = Union(tmp, ColFind.EntireRow) End If End If Set ColFind = OnRng.FindNext(ColFind) Loop While Not ColFind Is Nothing And ColFind.Address <> f End If If n > 0 Then On Error Resume Next ws.Activate If Not tmp Is Nothing Then Dim rng As Range For Each row In tmp.Rows If rng Is Nothing Then Set rng = ws.Range(ws.Cells(row.row, Colstar), ws.Cells(row.row, ColEnd)) Else Set rng = Union(rng, ws.Range(ws.Cells(row.row, Colstar), ws.Cells(row.row, ColEnd))) End If Next row rng.Select End If On Error GoTo 0 End If End Sub تم تعديل الأربعاء at 16:27 بواسطه محمد هشام. 1 رابط هذا التعليق شارك More sharing options...
عادل ابوزيد قام بنشر الأربعاء at 16:31 الكاتب مشاركة قام بنشر الأربعاء at 16:31 (معدل) استاذى الفاضل تحية شكر وتقدير على مجهودك الكبير وحلولك الرائعة بناء على توضيح حضرتك من حيث تكرار البيانات فعلاً البيانات مكررة ولكن للاسف سواء لرقم الملف او لاسم صاحب المعاش انها مرتبطه ببعض بمعنى ان لكل صاحب معاش رقم ملف خاص به ولكن قد يتكرر التعامل مع الملف وبالتالى الاسم اكثر من مرة ولذلك اقترحت ( لانى استنتجت هذا الربط فى الكود ) بان يكون العمل على عمود لا يتكرر فيه البيان وهذا العمود هو عمود الوارد لانه لن ولم يتكرر عكس المسلسل يتكرر فى الشهور بمعننى موجود فى شهر 7 وشهر 8 وشهر 9 وشهر 10 وهكذا اقتراح لعلاج ذلك : وضع شروط للتساوى هو تطابق رقم الوارد مع رقم الملف مع اسم صاحب المعاش ( وعدم الاكتفاء بالرقم وصاحب المعاش ) الافتراح الثانى : فما رايك بإدخال عمود الوارد فى الكود مع عدم اظهاره فى الليست .. ينفع ام لا ؟؟ تقبل تحياتى مع العلم بالتطبيق فى الملف الاخير وبالبحث وعند التعديل تبين ان التعديل يتم تنفيذه فى الصف الاول فى الشيت الذى به نفس البيانات كما بالمثال تم تعديل الأربعاء at 18:26 بواسطه عادل ابوزيد رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر منذ 3 ساعات مشاركة قام بنشر منذ 3 ساعات (معدل) نعم اخي المشكلة في طريقة البحث التي تستخدمها لهدا سنعتمد على طريقة متقدمة نوعا ما لتنفيد طلبك وتحديد الصف بدون الاعتماد على إسم او رقم الملف مع اظافة إمكانية البحث والفلترة بأي عمود Private Sub ListBox1_Click() Dim lastRow As Long: lastRow = f.Rows.Count f.Range("A7:A" & lastRow).Interior.ColorIndex = xlNone For i = 1 To OnRng Me("textbox" & i) = Me.ListBox1.Column(i - 1) Next i Me.N_ligne = Me.ListBox1.Column(i - 1) rng = Me.N_ligne + 6 If rng > 0 Then With f .Range(.Cells(rng, "C"), .Cells(rng, "N")).Select .Cells(rng, "A").Interior.Color = RGB(0, 0, 255) End With End If End Sub تعديل فورم V5 -.rar تم تعديل منذ 3 ساعات بواسطه محمد هشام. 1 1 رابط هذا التعليق شارك More sharing options...
عادل ابوزيد قام بنشر منذ 3 ساعات الكاتب مشاركة قام بنشر منذ 3 ساعات استاذى الفاضل تسلم ايدك .. بس هل هناك حل لنحافظ على عمود المسلسل ( نفس الملحوظة فى المشاركة السابقة مباشرة ) المسلسل ده بيتم كتابته فى سجل ورقى ويتم كتابته على الملف نفسه حتى يسهل العثور عليه فى السجل لتسجيل الاجراء ورقياً .. وده الهدف من المسلسل حفظكم الله ورعاكم وزادكم من نعمه وفضله رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر منذ 3 ساعات مشاركة قام بنشر منذ 3 ساعات نعم التعديل والاظافة ليس لها علاقة بالمسلسل انت من تضيفه يدويا فقط يتم فقدانه في حالة حدف الصف 1 رابط هذا التعليق شارك More sharing options...
عادل ابوزيد قام بنشر منذ 3 ساعات الكاتب مشاركة قام بنشر منذ 3 ساعات والبحث هل له علاقة ان شاء الله اجرب تعديل المسلسل على الوضع الطبيعى واوافيك بالنتيجة رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر منذ 2 ساعات مشاركة قام بنشر منذ 2 ساعات لا علاقة له بالمسلسل التحديد يتم بواسطة رقم الصف 1 رابط هذا التعليق شارك More sharing options...
mahmoud nasr alhasany قام بنشر منذ 2 ساعات مشاركة قام بنشر منذ 2 ساعات (معدل) احسنت ا / محمد هشام عمل رائع تم تعديل منذ 2 ساعات بواسطه mahmoud nasr alhasany رابط هذا التعليق شارك More sharing options...
عادل ابوزيد قام بنشر منذ 2 ساعات الكاتب مشاركة قام بنشر منذ 2 ساعات (معدل) تم تعديل رقم المسلسل ممكن بعد اذنك لو تكرمت اضافة رؤوس الاعمدة بالليست بوكس .. على ان يتم العمل على يوزرفورم 7 تعديل فورم V5 -.rar تم تعديل منذ 2 ساعات بواسطه عادل ابوزيد رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان