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

من بعد أذنك استاذ سليم طريقة أخرى TESTE55 With code.xlsm

الأستاذ Ali Mohamed Ali أكثر من رائع بوركك لله

جرب هذا أتمنى أن يعجبك معادلة جمع2.xlsm

بعد اذن الاستاذ بن علية حاجي هذا حل آخر بالكود مرفق شيت العمل.xlsm

صباح الخير ربما =IF(VLOOKUP(A5,'الخزينة وارد صادر'!A1:Z27,16,FALSE)=0,VLOOKUP(A5,'الخزينة وارد صادر'!A1:Z27,19,FALSE),VLOOKUP(A5,'الخزينة وارد صادر'!A1:Z27,16,FALSE))

حسب فهمي للموضوع: فقط اضغط على المربع الأزرق جمع خلايا.xlsm

region and language additional settings list separator

حسب اعدادات الويندوز (region and language)

على الأعلب يجب أن تستبدل ; بـ ,

صباح الخير ربما؟ اعبار أن ألداتا تبدأ من الخلية (ِA1) Sub test() Dim i For i = 670 To 1 Step -10 Cells(i - 9, 1).Resize(3).Select Selection.Insert Shift:=xlDown Next End Sub

New Microsoft Excel Worksheet.xlsm .Pattern = "\W+" أضف رموزك في في بداية الـ PATTERN

اوكي استبدل بـ .Pattern = "[.:*&^%$#@!!_\\/?<>-]" يمكنك Google regexp من أجل التفاصيل مثلا s =space.....

تجميع المكررات.xlsx

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

كتابة في خلية صفحة بناء على خلية صفحة أخرى.xls

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 تفضل

تفضل New Microsoft Excel Worksheet.xlsm

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

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) في حال انك تريد كود يعمل من خلال زر أرجو تحميل مثال لأطبقه لك بكل سرور

أخ عاطف آسف على التأخير أولا بالنسبة B = Sheets("الارقام").Range("d3").Resize(Sheets("الارقام").Cells(Rows.Count, 4).End(xlUp).Row - 5, 2) لقراءة الأرقام الجديدة والقديمة في "الأرقام" وتتم بعذ ذلك مقارنة القيم في العمود c (مصفوفة A)مع العمود الأول من المصفوفة B , في حال التطابق يقوم بتغيير القيمة في A بالقيمة في العمود الثاني من المصفوفة B بالنسبة لـ "لاحظت ان الكود لايعمل اذا كان عدد الارقام المطلوب تغييرها أقل من 4 هل هذا صحيح ؟" آسف أن اقول لك ان هذا غير صحيح

الحمد لله أنه تم المطلوب شكرا لكم

استبدل الكود بـ 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

تفضل Suivi des Créances1.xlsm

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

أرجو أن يكون المطلوب بحث واستبدال متكرر (2).xlsm