حسين مامون

ربما تقصد هذا البحث في بداية الاسم.xlsm

تفضل تجربة.xlsm

كان عليك البحث في المنتدى اولا اليك الموضوع التالي فيه ضالتك

تفضل يرجى تعديل كود الحذف والتعديل (1).xlsm

جرب ورد يرجى تعديل كود الحذف والتعديل (1).xlsm

تفضل اتمنى ان يكون ما تريد تحياتي يرجى تعديل كود الحذف والتعديل (1).xlsm

القيم __.xlsm

تفضل جرب المرفق hg.xlsm

تفضل القيم __.xlsm

جرب المرفق كود في حدث الشيت ويفي بالغرض ان شاء الله القيم __.xlsm

لا يمكن التعديل بدون شرط والا كيف يمكن للكود ان يجد البيان المختار ضمن مئات البيانات؟ عموما الشرط هنا هو رقم الرو اختر شيت في الكومبوبوكس ثم عدل ما تريد واضغط زر العديل يرجى تعديل كود الحذف والتعديل (1).xlsm

تفضل يرجى تعديل كود الحذف والتعديل (1).xlsm

جرب المرفق زر تعديل يقوم بتعديل في جميع الشيتات بناء على الاسم المختار في ليستبوكس تحياتي يرجى تعديل كود الحذف والتعديل (1).xlsm

انسخ الكود في مشاركتي السابقة ثم الصقه داخل الفورم لا اكثر ولا اقل عندي شغال 100/100

وهل جميع الشيتات متشابهة؟ يعني في نفس الرو يوجد نفس الاسم حتى لو كانت اكثر من 100 شيت ؟

تعديل.rar

الكود يعمل فقط على الشيت النشط يمكنك تعديله باضافة with activesheet في بداية الكود و end with t في اخره مع اصافة نقطة لبداية السطور لي تبدأ ب cells Dim lr, i, j With ActiveSheet Application.ScreenUpdating = False lr = .Cells(Rows.Count, 1).End(3).Row For i = 2 To lr If Label33.Caption = .Cells(i, 1).Row Then For j = 1 To 26 .Cells(i, j) = Controls("TextBox" & j).Text Next j Exit For End If Next i Application.ScreenUpdating = False End With

هذه صورة عم رقم 1 قبل التعديل وهذه بعد التعيل

Dim r As Integer Private Sub CommandButton1_Click() Dim lr, i, j Application.ScreenUpdating = False lr = Cells(Rows.Count, 1).End(3).Row For i = 2 To lr If Label33.Caption = Cells(i, 1).Row Then For j = 1 To 26 Cells(i, j) = Controls("TextBox" & j).Text Next j Exit For End If Next i Application.ScreenUpdating = False End Sub Private Sub CommandButton3_Click() If TextBox7.Value = "" Then MsgBox "áÇÊæÌÏ ÈíÇäÇÊ ááÍÐÝ", vbCritical, "ÊäÈíå" Exit Sub End If If MsgBox("ÓíÊã ÇáÍÐÝ åá ãÊÃßÏ¿", vbQuestion + vbYesNo) = vbYes Then lro = Sheets(ComboBox1.Value).Cells(Rows.Count, 7).End(xlUp).Row Set m = Sheets(1).Range("A" & r & ":A" & lro) For Each cell In m cell.Value = cell.Value - 1 Next Sheets(ComboBox1.Value).Cells(r, 1).Resize(, 55).Delete shift:=xlUp MsgBox "ÊãÊ ÚãáíÉ ÇáÍÐÝ ÈäÌÇÍ" For y = 1 To 55 Controls("textbox" & y).Text = "" Next y ListBox1.Clear UserForm_Activate TextBox100 = "" End If TextBox1.Value = Application.WorksheetFunction.Max(Sheets(ComboBox2.Value).Range("A2:A10000")) + 1 TextBox2.SetFocus End Sub Private Sub CommandButton4_Click() TextBox100.Value = "" ListBox1.Clear End Sub Private Sub ListBox1_Click() For i = 0 To ListBox1.ListCount If ListBox1.Selected(i) = True Then For j = 1 To 26 Controls("TextBox" & j).Text = Sheets(ListBox1.List(i, 1)).Cells(ListBox1.List(i, 2), j) Label33.Caption = Sheets(ListBox1.List(i, 1)).Cells(ListBox1.List(i, 2), j).Row Next j r = ListBox1.List(i, 2) Exit For End If Next i End Sub Private Sub TextBox1_Change() End Sub Private Sub TextBox2_Change() End Sub Private Sub TextBox27_Change() If TextBox27.Value <> "" Then ListBox1.Visible = True Else ListBox1.Visible = False End If Dim x As Worksheet Dim c As Range ListBox1.Clear k = 0 For i = 1 To 26 Controls("TextBox" & i).Text = "" Next i If TextBox27 = "" Then Exit Sub For Each x In ThisWorkbook.Worksheets SS = x.Cells(Rows.Count, 2).End(xlUp).Row For Each c In x.Range("B2:B" & SS) b = InStr(c, TextBox27) If Trim(c) Like "*" & TextBox27 & "*" Then ListBox1.AddItem ListBox1.List(k, 0) = x.Cells(c.Row, 2) ListBox1.List(k, 1) = c.Worksheet.Name ListBox1.List(k, 2) = c.Row k = k + 1 End If Next c Next x End Sub Private Sub TextBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean) TextBox27.Value = "" ListBox1.Clear End Sub

هذا هو الكود كما ارسلته سابقا ولكن يجب اضافة ليبل للفورم وسميه "Label33" Private Sub CommandButton1_Click() Dim lr, i, j Application.ScreenUpdating = False lr = Cells(Rows.Count, 1).End(3).Row For i = 2 To lr If Label33.Caption = Cells(i, 1).Row Then For j = 1 To 26 Cells(i, j) = Controls("TextBox" & j).Text Next j Exit For End If Next i Application.ScreenUpdating = False End Sub

ضع الكود لي في زر تشغيل الصوت في حدث الفورم Private Sub UserForm_Initialize() WindowsMediaPlayer1.URL = ThisWorkbook.Path & "\20.MP3" WindowsMediaPlayer1.Controls.Play End Sub

ضع هذا الشيء في الخلية g7 واسحب نزولا =if(K7;K7;"") و نفس الشيء في c7

اليك الملف يعمل عندي بكفاءة يرجى تعديل كود الحذف والتعديل.xlsm

تفضل New 5.xlsm

تفضل اخي الكريم ملئ بشرط.xlsm