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

محي الدين ابو البشر

03 عضو مميز
  • Content Count

    368
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

152 Excellent

1 متابع

عن العضو محي الدين ابو البشر

  • الإسم الفعلي
    الإســم

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    eng

اخر الزوار

1,379 زياره للملف الشخصي
  1. New Microsoft Excel Worksheet.xlsm .Pattern = "\W+" أضف رموزك في في بداية الـ PATTERN
  2. اوكي استبدل بـ .Pattern = "[.:*&^%$#@!!_\\/?<>-]" يمكنك Google regexp من أجل التفاصيل مثلا s =space.....
  3. Sub txtonly() Dim a, m, x, i a = Cells(2, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1) With CreateObject("vbscript.regexp") .Global = True .MultiLine = False .Pattern = "(\*+)|(\.)|(\&)|(\^)(\%)|(\$)|(\#)|(\@)|(\!)|(\d+)" For i = 1 To UBound(a) a(i, 1) = Trim(.Replace(a(i, 1), "")) Next End With [b2].Resize(UBound(a)) = a End Sub
  4. Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A:A")) Is Nothing Then With Sheets("Sheet2") .Range("b11").Offset(Target.Row - 1) = Target.Value End With End If End Sub تفضل
  5. Sub test() Dim a, i, x With ActiveSheet x = Cells(4, 9) a = Range(Cells(4, 4), Cells(40, 4)) For i = 1 To UBound(a) If a(i, 1) = x Then: a(i, 1) = Empty Next .Cells(4, 12).Resize(UBound(a)) = a End With End Sub
  6. Function txtonly(rng As Range) Dim m, x, i With CreateObject("vbscript.regexp") .Global = True .MultiLine = False .Pattern = "[a-zA-Z]+" Set m = .Execute(rng) For i = 0 To m.Count - 1 x = x & m(i) Next End With txtonly = x End Function @Access2020 هذه دالة يمكن استخدامها في اكسل شيت مثلا : النص في الخلية A1 في الخلية B2 B2=Txtonly(A1) في حال انك تريد كود يعمل من خلال زر أرجو تحميل مثال لأطبقه لك بكل سرور
  7. أخ عاطف آسف على التأخير أولا بالنسبة B = Sheets("الارقام").Range("d3").Resize(Sheets("الارقام").Cells(Rows.Count, 4).End(xlUp).Row - 5, 2) لقراءة الأرقام الجديدة والقديمة في "الأرقام" وتتم بعذ ذلك مقارنة القيم في العمود c (مصفوفة A)مع العمود الأول من المصفوفة B , في حال التطابق يقوم بتغيير القيمة في A بالقيمة في العمود الثاني من المصفوفة B بالنسبة لـ "لاحظت ان الكود لايعمل اذا كان عدد الارقام المطلوب تغييرها أقل من 4 هل هذا صحيح ؟" آسف أن اقول لك ان هذا غير صحيح
  8. استبدل الكود بـ Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("e:e")) Is Nothing Then With Target On Error GoTo 1 If Target <> "" Then .Offset(, -3) = "BFL" .Offset(, 2) = 0 .Offset(, 3) = "398" End If End With End If 1 End Sub أو Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("e:e")) Is Nothing Then With Target If Target.Count > 1 Then Exit Sub If Target <> "" Then .Offset(, -3) = "BFL": .Offset(, 2) = 0: .Offset(, 3) = "398" End If End With End If End Sub
×
×
  • اضف...