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

السلام عليكم ربما? =IFERROR($C$6:$C$4329;INDEX(الارقام!$D$3:$D$42;MATCH($C$6:$C$4329;الارقام!$E$3:$E$42;)))

باستخدام كود اذا رغبت 111.xlsx 111.xlsm

السلام عليكم If WorksheetFunction.CountIf(myrang, fullname) >= 1 Then

السلام عليكم Adobe Acrobat 10.0 Type Library

السلام عليكم اولا ملفك او الشيت محمي بكلمة سر لا يمكن العمل عليه ثانياً مشكلتك تحل بتنسيق الخلايا calender Type>>Hijri

الحمد لله اني استطعت المساعدة وشكراً لك

السلام عليكم ActiveSheet.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=Environ("USERPROFILE") & "\Desktop\" & ID & ".Pdf", _ IgnorePrintAreas:=False, _ Openafterpublish:=False

Sub test() Dim a As Variant, lr, i, x, s, k, itm Dim bch As Worksheet Set bch = Sheets("Bank Cheque") lr = bch.Cells(Rows.Count, "a").End(xlUp).Row - 1 a = Application.Index(bch.Cells(2, 2).Resize(lr, 21).Value, Application.Evaluate("row(1:" & lr & ")"), Array(1, 2, 6, 7, 8, 13, 16, 20)) With CreateObject("scripting.dictionary") For i = 1 To UBound(a) If bch.Cells(i + 1, 4) = Sheets("Sheet4").Range("d3") And bch.Cells(i, 4) <> "" Then If Not .exists(Cells(i + 1, 4)) Then .Add bch.Cells(i + 1, 4), a(i, 1) & Chr(162) & a(i, 2) & Chr(162) & a(i, 3) & Chr(162) & a(i, 4) & Chr(162) & a(i, 5) & Chr(162) & a(i, 6) & Chr(162) & a(i, 7) & Chr(162) & a(i, 8) Else .Item(bch.Cells(i + 1, 4)) = .Item(Cells(i + 1, 4)) & Chr(162) & a(i, 1) & Chr(162) & a(i, 2) & Chr(162) & a(i, 3) & Chr(162) & a(i, 4) & Chr(162) & a(i, 5) & Chr(162) & a(i, 6) & Chr(162) & a(i, 7) & Chr(162) & a(i, 8) End If End If Next k = .keys itm = .items Ct = .Count With Sheets("Sheet4") Range("a8:f10000").ClearContents For i = 1 To Ct x = Split(itm(i - 1), Chr(162)) .Range("a" & 8 + i - 1).Resize(, UBound(x) + 1) = x Next End With End With End Sub اسم الشركة فيD3

جزاك الله كل خير وبارك لك

في الـ Sheet2 يوجد كود في هذه الحالة يرصد اي تغيير في الـ Sheet2 فعندم تتغيير قيمة F3 or G3 يعمل الكود

ترحيل خليه محدده بدون التنسيق.xlsm

بدون معادلات فقط بتغيير F3,G4 إستخراج بيانات.xlsm

Sub test() Dim a As Variant, lr, i lr = Cells(Rows.Count, 2).End(xlUp).Row a = Range("b3:b" & Cells(Rows.Count, 2).End(xlUp).Row).Resize(, 5) With CreateObject("scripting.dictionary") For i = 1 To UBound(a) If a(i, 1) <> 0 Then If Not .exists(a(i, 1)) Then .Add a(i, 1), a(i, 5) Else .Item(a(i, 1)) = .Item(a(i, 1)) & "-" & a(i, 5) End If End If Next For i = 1 To lr - 2 Cells(2 + i, 2).Offset(, 6) = .Item(Cells(2 + i, 2).Value) Next End With End Sub

أخي العزيز سليم كلامك صحيح مشكور

Sub test() Dim a As Variant, lr, i lr = Cells(Rows.Count, 2).End(xlUp).Row a = Range("b3:b" & Cells(Rows.Count, 2).End(xlUp).Row).Resize(, 6) With CreateObject("scripting.dictionary") For i = 1 To UBound(a) If a(i, 1) <> 0 Then If Not .exists(a(i, 1)) Then .Add a(i, 1), a(i, 5) Else .Item(a(i, 1)) = .Item(a(i, 1)) & "-" & a(i, 5) End If End If Next For i = 1 To lr - 2 Cells(2 + i, 2).Offset(, 6).Select Cells(2 + i, 2).Offset(, 6) = .Item(Cells(2 + i, 2).Value) Next End With End Sub

أستاذ السلام عليكم أبو-عبد-النور بارك الله بجهودك

السلام عليكم جميل بارك الله بك

السلام عليكم بارك الله بك وبجهودك

السلام عليكم بالنسبة لطلبك الثاني Private Sub Workbook_Open() Me.Sheets("ورقة1").Select End Sub ضع هذا الشيء في حدث thisworkbook

السلام عليكم هذا جميل وجميل جداُ أععني التكنيك الجديد أخيرا بدأنا نستخدم هكذا تقنيات بارك الله بك وبجهودك LIKE

السلام عليكم بارك الله بك وبجهودك الممتازة دمت ذخراً

السلام عليكم يارك الله وادامك ذخراً

السلام عليكم ما شاء الله

السلام عليكم بالفعل افاكر نيرة وذكاء بالاستخدام أدامك الله

السلام عليكم العملية في الاكسل تتم بالعكس تماما مثلا تدمج خليتين في الأعلى مثلا "البند بالمقاسية" هي دمج خليتين متجاورتين ثم اسفلها يكون لديك رقم كتابة كما في الصورة\وكذا الامر بالنسبة لثلاث خلايا وهكذا حاول وسترى كم هي سهلة