سليم حاصبيا

ربما كان المطلوب في هذا الملف salim tajribat.xlsx

جرب هذا الكود F34 to A1 تحديد مدى الطباعة من في الكود الاول يجب ازالة كلمة Rem من أمام السطر الذي تريده لاننا امام خيارين (معاينة قبل الطباعة Print Preivew او طباعة رأساً Print) Option Explicit Sub Button1_Click() PRint_erea 'اختر هنا السطر الذي تريده ' من امامه Rem و ذلك بازالة كلمة Rem ActiveSheet.PrintPreview Rem ActiveSheet.Print End Sub '====================================== Sub PRint_erea() Range("E14:E37").EntireRow.Hidden = False Range("E14:E37").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True End Sub '===================================== Sub SHOW_ROWS() Range("E14:E37").EntireRow.Hidden = False End Sub الملف مرفق Print_tableau.xls

ربما يكون هذا الكود تم اضافة الكود verification للتأكد من وجود الشيت Option Explicit Dim x%, t As Boolean '======================================== Sub give_data_old_code() If ActiveSheet.Name <> "الترحيل" Then GoTo Exit_Me With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim my_sht As Worksheet Dim my_str$ Dim Source_Sheet As Worksheet: Set Source_Sheet = Sheets("الترحيل") Dim T_sh As Worksheet Dim My_Table As Range: Set My_Table = Source_Sheet.Range("c4").CurrentRegion Dim nRow%: nRow = My_Table.Rows.Count + 3 Dim I%, laste_row% For Each T_sh In Worksheets If T_sh.Name <> Source_Sheet.Name Then Range(T_sh.Range("b5"), T_sh.Range("b4").End(xlDown)).Resize(, 5).ClearContents End If Next For I = 5 To nRow my_str = Source_Sheet.Range("c" & I) Call verfication(my_str) If Not t Then GoTo 1 Set my_sht = Sheets(Source_Sheet.Range("c" & I) & "") laste_row = my_sht.Cells(Rows.Count, 2).End(3).Row + 1 my_sht.Range("B" & laste_row).Resize(, 6).Value = Source_Sheet.Range("c" & I).Resize(, 6).Value 1: Next Exit_Me: With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub '===================================== Sub verfication(sh_name) On Error Resume Next t = False x = Len(Sheets(sh_name).Name) If x Then t = True On Error GoTo 0 End Sub

حرب هذا الكود Option Explicit Sub give_data() If ActiveSheet.Name <> "الترحيل" Then GoTo Exit_Me With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim T_sh As Worksheet Dim My_Table As Range: Set My_Table = sheets("الترحيل").Range("c4").CurrentRegion For Each T_sh In Worksheets If T_sh.Name <> "الترحيل" Then With T_sh .Range("b4").CurrentRegion.Clear .Range("h1") = "اسم الحساب" .Range("h2") = .Name My_Table.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=.Range("H1:H2"), _ CopyToRange:=.Range("B4:f4") .Columns("b:f").AutoFit .Range("H1:H2").Clear End With End If Next Exit_Me: With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub ولا ادري ما سبب ضخامة هذا الملف (حوالي 3 ميغا) الملف مرفق ترحيلsalim11.rar

شاهد هذا الفيديو https://www.youtube.com/watch?v=9PPVWGJUtZ4

ربما تنفع هذه الدالة =CEILING(B2,0.05)

بعد اذن اخي علي هذا الملف مع امكانية زيادة البيانات Mh_most.xlsx

بعد اذن اخي زيزو حل اخر Salim_filter.xls

طريقة ة اخرى ربما كانت مفيدة (بدون اي تنسيق للخلية) الشرح في هذه الصورة

هذا ما يفغله الاكسل في الملف

ليس هناك مجال للتخمين في اكسل من فضلك ارفع ملفاً نموذجأً عما تريدين وان شاء الله تلقى المساعدة

لا حظ هذه الصورة هذه بعد التنسيق

الخلية لا تتسع الى اكثر من 16 رقم (اذا كان تنسيقها Number ) لكن في حال تنسيق Text يمكن كتابة اي شيء

قم بكتابة البيانات في الاعمدة C & D & E (في هذا المرفق الجديد) مع حرية تعديل الرقم في H6 (لكتابة نسبة مئوية يجب كتابة الرقم مقسوم على 100) مثلاً لادراج 25% نكتب 0.25 و لارداج 3% نكتب 0.03 لارداج 100% نكتب 1 وهكذا......) كلما كتبت شيئاً تظهر لك النتيجة في نفس الصف مع تغيير ما تراه مناسباً في العامود L محمد خاطر salim_shcool.xlsx

بعد اذن اخي علي الملف مرفق محمد خاطر salim.xlsx

أيوا ولا ربط كمان

نعم اكسل يقوم بهذا الامر بمعادلة مع تنسيق شرطي شرح المعادلة في هذه الصورة الملف مرفق DUP_FORMATdeveloped.xlsx

هذه المعادلة تعطيك تص او بالاحرى رقم على هيئة نص لا تستطيع عمل حسابات عليه (جمع او طرح الى اخره) ليكون الجواب رقما يمكن العامل معه بالحسابات يجب استعمال هذه المعادلة =B13*B9/1440 هنا يجب تنسيق خلية الاجوبة بهذا الشكل h]:mm]

اخي علي لا داعي للـــ Sum ولا للــ Text يكفي =INT($B$13*B$9/60)&":"&MOD($B$13*B$9,60)

هذه المعادلة =(QUOTIENT((B13*B9),60)&":"&MOD(B13*B9,60))

الملف لا يمكن تحميله ولا ادري ما السبب اعد تحميله مرة ثانية

استعمل احد هاتين المعادلتين (حسب اعدادات الجهاز عندك الفاصلة او الفاصلة المنقوطة) اذا لم تعمل الاولى سوف تعمل الثانية =IFERROR(INDIRECT(VLOOKUP($A$1,{3,"B1";9,"B1";4,"B2";10,"B2";5,"B3";11,"B3";6,"B4";12,"B4"},2,0)),"No Data") =IFERROR(INDIRECT(VLOOKUP($A$1;{3,"B1";9,"B1";4,"B2";10,"B2";5,"B3";11,"B3";6,"B4";12,"B4"};2;0));"No Data") الملف مرفق Equation.xlsx

رغم انك لم ترفع ملقاً للتعامل معه لكن عندي انا هذا الملف القديم (مثال عما تريد) أرجو أن يفي بالغرض product &Prices.xlsx

اذا كنت تريد ان يظهر لك ما يحتوي التحديد الذي قمت به (بدون الخلايا الفارغة) استعمل هذا الملف الكود Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Selection.Cells(1, 1).Column = 1 Then Exit Sub If Selection.Cells.Count > 50 Then MsgBox "Too Many Data" Exit Sub End If Dim lasteRow Dim x% lasteRow = Cells(Rows.Count, 1).End(3).Row If lasteRow = 1 Then lasteRow = 2 If Application.CountA(Target) = 0 Then With Range("A1") .Value = Selection.Address With .Offset(1) .Resize(lasteRow, 1).Clear .Value = "Selection is Empty " .Interior.ColorIndex = 8 End With With .Offset(2) .Value = "ActiveCell is : " & ActiveCell.Address .Interior.ColorIndex = 3 .Font.ColorIndex = 2 End With End With Exit Sub End If Dim arr() Dim k%: k = 1 Dim cel As Range For Each cel In Selection If cel <> vbNullString Then ReDim Preserve arr(1 To k) arr(k) = cel.Value k = k + 1 Else: x = x + 1 End If Next With Me.Range("a1") .Value = Selection.Address .Offset(1).Resize(lasteRow, 1).Clear .Offset(1).Resize(k - 1, 1).Value = Application.Transpose(arr) With .Offset(k) .Value = "Active Cell is : " & ActiveCell.Address .Interior.ColorIndex = 3 .Font.ColorIndex = 2 With .Offset(1) .Value = "Items: " & Selection.Cells.Count - x .Interior.ColorIndex = 7 .Font.ColorIndex = 2 End With End With End With Me.Range("A:A").Columns.AutoFit Range("B1") = "Selection Address" Erase arr End Sub GET adderss of selection.xlsm

THIS CODE Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Me.Range("a1") .Offset(1).Resize(1000, 1) = vbNullString .Value = Selection.Address .Offset(1).Resize(Selection.Rows.Count, 1).Value = Selection.Value End With End Sub