سليم حاصبيا

جرب هذا الكود Option Explicit Sub creat_shett() Dim i%, t, m% Dim x%: x = Application.CountA(Sheets("Principal").Range("A:A")) + 1 For i = 3 To x t = Sheets("Principal").Range("a" & i) On Error Resume Next m = Len(Sheets(t).Name) On Error GoTo 0 If m = 0 Then '===========================================================' Sheets("Main").Copy After:=Sheets(Sheets.Count) With ActiveSheet .Name = Sheets("Principal").Range("a" & i) .Range("a1") = .Name End With '===========================================================' End If m = 0 Next Sheets("Principal").Select End Sub الملف مرفق مسحوبات.xlsm

بعد اذن اخي علي كود اسرع قليلاُ لا يقوم بقراءة البيانات صفاُ بعد صف Option Explicit Sub tranfer_data() Dim x Dim arr(), k%: k = Sheets.Count - 1 Dim my_rg As Range Set my_rg = Sheets("المنتجات").Range("a1").CurrentRegion For x = 2 To k ReDim Preserve arr(1 To x - 1): arr(x - 1) = Sheets(x).Name Sheets(x).Cells.ClearContents Next For x = LBound(arr) To UBound(arr) my_rg.AutoFilter 1, arr(x) my_rg.SpecialCells(12).Copy _ Sheets(arr(x)).Range("a1") Next Erase arr

جرب هذا الملف رقم الفاتورة .xlsx

ربما هذا الكود يعمل ما تريد Sub ahmad() Dim source As Worksheet Dim Targ As Worksheet Set source = Sheets("Sheet1") Set Targ = Sheets("Sheet2") Dim col% Dim last_row% Targ.Cells.Interior.ColorIndex = 2 col = source.Cells(1, Columns.Count).End(1).Column last_row = Targ.Cells(Rows.Count, 1).End(3).Row + 1 With Targ.Cells(last_row, 1).Resize(1, col) .Value = source.Range("a2").Resize(1, col).Value .Interior.ColorIndex = 6 End With End Sub

جرب هذه المعادلة =IFERROR(INDEX($F$9:$F$100,MATCH(SUM($D$3,$F$3),$G$9:$G$100,0)),"No Data")

جرب هذا الملف البحث _salim.xlsm

جرب هذا المعادلة في الخلية C3 واسحب نزولاً =IF(OR(COUNTIF($G$3:$G$50,$B3)=0,$B3=""),"",VLOOKUP($B3,$G$3:$H$50,2,0)) الملف مرفق _1المبيعات.xlsx

بعد اذن الاخ علي وزيادة في اثراء الموضوع هذه المعادلة (Ctl+Shift+Entre ) =IF(ISNUMBER(MATCH(E3,ROW(INDIRECT($E$1&":"&$F$1)),0)),"OK","")

جرب هذا الملف (لا حاجة لليوزرفورم ) الكود Option Explicit Sub tranfere_data() Dim Source As Worksheet: Set Source = Sheets("Sheet1") Dim Trg As Worksheet: Set Trg = Sheets("Sheet2") Dim Last_Row%, Last_Col% Dim Rg_To_Copy Dim My_place% Set Rg_To_Copy = Source.Range("a1").CurrentRegion Last_Row = Rg_To_Copy.Rows.Count Last_Col = Rg_To_Copy.Columns.Count Set Rg_To_Copy = Rg_To_Copy.Offset(1).Resize(Last_Row - 1) My_place = Trg.Cells(Rows.Count, 1).End(3).Row + 1 If My_place <> 2 Then My_place = My_place + 1 Trg.Cells(My_place, 1).Resize(Last_Row - 1, Last_Col).Value = _ Rg_To_Copy.Value Trg.Cells(My_place, 1).Offset(, Last_Col + 1) = Time Trg.Cells(My_place, 1).Offset(, Last_Col + 2) = Date End Sub الملف مرفق salim_tasjil.xlsm

ارفع مثالاً عما تريد لا يمكن التكهن بنتيجة لا نعرف تفاصيل معطياتها

عند دمج عدة خلايا فان اكسل يعطي قيمة الخلية الاولى في حقل الدمج(هذا هو محتوى رسالة التتحذير) لذلك هذه الطريقة لا تعطي نتيجة استعمل هذه المغادلة =B11&" "&C11&" "&D11 الملف مرفق 11-208.xlsx

جرب هذه المعادلة =IF(N(C2)<=0,"",VLOOKUP(C2,{0,0;31,75;121,85;181,100},2)) اذا لم تعمل المعادلة معك استبدل الفاصلة بفاصلة منقوطة ( الفاصلة خارج الأقواس { } ) (حسب اعدادات الحهاز عندك) لتصبح المعادلة بهذا الشكل =IF(N(C2)<=0;"";VLOOKUP(C2,{0,0;31,75;121,85;181,100};2)) بالنسبة للخاية الثانية نفس المعادلة مع تغيير المعطيات

يجب حفظ الملف بصيغة xlsm. ليبقى الماكرو يعمل عند اعادة فتح الملف

اذا لم تعمل المعادلة معك استبدل الفاصلة بفاصلة منقوطة ( الفاصلة خارج القوسين { } ) (حسب اعدادات الحهاز عندك) لتصبح المعادلة بهذا الشكل =IF(OR(A2="";B2="");"";A2*VLOOKUP(B2;{"بدون درجة",0;"الاولى",150;"الثانية",125;"الثالثة",100;"كبير",200;"خبير",175};2;0)/100)

جرب هذا المعادلة =IF(OR(A2="",B2=""),"",A2*VLOOKUP(B2,{"بدون درجة",0;"الاولى",150;"الثانية",125;"الثالثة",100;"كبير",175;"خبير",200},2,0)/100)

اكثر اختصاراً Option Explicit Sub test_Me() Dim i As Byte For i = 2 To 7 Cells(i, 2) = IIf(Cells(i, 1) >= 50, "ناجح", "راسب") Next End Sub

انت لم تكتب الدالة املائياً بالشكل المطلوب sumproudct المطلوب sumproduct على كل حال اليك الملف Salimه الصحافة.xlsx

هذه المعادلة =SUMPRODUCT(--($D$2:$D$1000=100))

من الواضح ان المحتويات الخلايا C ليست ارقاماً (بل هي نص على شكل رقم ازاحة البيانات على يسار الخلية واضحة) يمكن التأكد من ذلك من خلال هذه المعادلة =ISNUMBER(C3) و هنا تحصل على False لذلك يجب تنسيق الخلايا C على شكل رقم من خلال التنسبق genaral او استعمال هذه المعادلة (اذا كنت لا تريد تنسيق الخلية) =$A$3*(B3+0)

لا اعرف اذا كان هذا المطاوب يالضبط My_sum.xlsx

الماكرو لا يعمل الا اذا كان كل الصف (من الجدول) الذي تنتقل اليه كاملا (لا خلايا فارغة) ولا يعمل ايضاً اذا كان الانتقال خارج الجدول

الكود يكتب هكذا Option Explicit Sub test_Me() Dim i As Byte For i = 2 To 7 With Cells(i, 1) If .Value >= 50 Then Cells(i, 2) = "ناجح" Else Cells(i, 2) = "راسب" End If End With Next End Sub

هذا الملف من موضوعاتي القديمة يتحدث عن هذا الامر Super Adv_Filter.xlsm

جرب الملف على هذا العنوان (يمكنك التعديل عليه بما يناسبك) https://www.officena.net/ib/topic/86206-صادر-وارد/

ريما ينفع هذا الكود Sub Salim_Code() Dim Source As Worksheet: Set Source = Sheets("دوامات") Dim x$: x = Source.Range("b2") Dim Target_sh As Worksheet: Set Target_sh = Sheets(x) Dim last_row%: last_row = Application.CountA(Source.Range("a:a")) - 1 If last_row = 1 Then last_row = 5 Dim k%, laste_col_source%, laste_col_target% For k = 1 To 500 If Source.Cells(5, k) = vbNullString Then Exit For Next laste_col_source = k - 1: k = 0 For k = 1 To 500 If Target_sh.Cells(1, k) = vbNullString Then Exit For Next laste_col_target = k: k = 0 Target_sh.Cells(1, laste_col_target).Resize(last_row + 1, 1).Value = _ Source.Cells(5, laste_col_source).Resize(last_row + 1, 1).Value End Sub الملف مرفق ترحيل اعمال.xlsm