سليم حاصبيا

هات مثالاً عما تريد

لا يمكن التعامل مع صورة ارفع الملف نفسه

تستعمل هذه المعادلة للترقيم مع تجاهل الفراغات انظر الى هذا المثال Formula_question.xlsx

لا أعلم كيفية استخراج الميلاد والمحافظة من الرقم القومي قمت بالتخمين للميلاد بهذا الشكل 31402212601224 الميلاد 2014/2/21 ربما كان صحيحاً فاذا كان لديك اي فكرة ارجو التفضل بها لاستطيع المساعدة

المشكلة بسيطة جداً يمكن معالجتها باضافة سطر واحد على الكود ( ما هو موجود بين علامات +++++++) ليصبح الكود بهذا الشكل Option Explicit Sub Give_Data() Dim Dic As Object Dim i%, Itm, k Dim max_ro%, Laste_Row% Dim Sh As Worksheet 'source_sheet (acc) Dim Th As Worksheet ' Target_sheet (net) Set Sh = Sheets("acc"): Set Th = Sheets("net") max_ro = Th.Cells(Rows.Count, 1).End(3).Row If max_ro = 1 Then max_ro = 2 Th.Range("a24:b" & max_ro).ClearContents Laste_Row = Sh.Cells(Rows.Count, "H").End(3).Row If Laste_Row < 2 Then MsgBox "No Data" Exit Sub End If Set Dic = CreateObject("Scripting.Dictionary") With Dic For i = 2 To Laste_Row If Sh.Range("H" & i) <> vbNullString _ And Sh.Range("F" & i) = Th.Range("d1") Then k = Sh.Range("H" & i) Itm = Sh.Range("C" & i) - Sh.Range("E" & i) If Not .Exists(k) Then .Add k, Itm Else Dic(k) = Dic(k) + Itm End If '++++++++++++++++++++++++++++++++++++ If Dic(k) = 0 Then .Remove k '++++++++++++++++++++++++++++++++++++ End If Next i Th.Range("A24").Resize(.Count, 1) = Application.Transpose(.keys) Th.Range("B24").Resize(.Count, 1) = Application.Transpose(.Items) End With '=============== Dic.RemoveAll: Set Dic = Nothing End Sub الملف مرفق Exemple _New_sans_Zero.xlsm

استبدل هذا السطر من الكود Set serch_range = Sheets("المعطيات").Range("R3:R12") بهذا ( S بدل الـــــ R الثانية) Set serch_range = Sheets("المعطيات").Range("R3:S12")

ربما هذا الكود يقوم بالغرض Sub colorize_table() Application.ScreenUpdating = False Dim Find_Rg As Range, r%, i% Dim serch_range As Range Set serch_range = Sheets("المعطيات").Range("R3:R12") Dim start_rg As Range Dim last_ro%: last_ro = Sheets("data2").Cells(Rows.Count, 2).End(3).Row Dim k% For k = 9 To 18 Step 2 Cells(6, k).Resize(last_ro - 4).Interior.ColorIndex = 40 Cells(6, k + 1).Resize(last_ro - 4).Interior.ColorIndex = 24 Next i = 7 Do Until Sheets("data2").Range("c" & i) = vbNullString Set start_rg = Sheets("data2").Range("H" & i) Set Find_Rg = serch_range.Find(Sheets("data2").Range("c" & i)) If Not Find_Rg Is Nothing Then r = Find_Rg.Row - 2 Else: GoTo Next_i End If start_rg.Offset(, r).Interior.ColorIndex = 6 Next_i: i = i + 1 Loop Application.ScreenUpdating = True End Sub الملف مرفق My_File.xlsm

من اولى الواجبات حفظ حقوق النشر لماذا لم تذكر اسم من وضع الكود لعملك؟؟؟....... اذا تكرر الامر سأقوم أسفاً يحذف المشاركة

جرب هذا الكود Option Explicit Sub tarnsfer_Data() Dim My_rg As Range Dim i% Dim fisrt_row: fisrt_row = 1 Sheets("Sheet3").Range("a1").Resize(500, 10).ClearContents For i = 1 To Sheets.Count If Sheets(i).Name <> "Sheet3" Then Set My_rg = Sheets(i).Range("a2").CurrentRegion Sheets("Sheet3").Cells(fisrt_row, My_rg.Columns.Count + 1) = _ "Begining of " & Sheets(i).Name Sheets("Sheet3").Range("a" & fisrt_row). _ Resize(My_rg.Rows.Count, My_rg.Columns.Count).Value = _ My_rg.Value fisrt_row = fisrt_row + My_rg.Rows.Count + 1 Sheets("Sheet3").Cells(fisrt_row - 2, My_rg.Columns.Count + 1) = _ "End of " & Sheets(i).Name End If Next End Sub الملف مرفق DATA.xlsm

حيث لا يوجد شهور فوق الـــ 12 (اذا صادف مثل هذا التاريخ 22/3/2015) كيف تستبدل اليوم بالشهر لا يوجد شهر 22 لذلك قمت باستبدال الشهر بـــ 22 -12 أي 10 لا حيلة لا بهذا الملف Playing with date.xlsx

هذه المعادلة في الخلية C1 و اسحب نزولاً =IF(A1+0<TODAY(),"",A1+0)

تم معالجة الأمر والملف في المشاركة Exemple _New.xlsm

عسى ان يكون المطلوب Crazy_sum.xlsx

و هل يجوز ان يكون نفس الاسم (زبون و شريك في نفس الوقت) كما هو الحال مع أحمد على كل حال تم التعديل كما تريد Exemple _New.xlsm

المعادلة المطلوبة في الخلية C3 =IF(OFFSET(INDIRECT($B3&"!h8"),,COLUMNS($A$1:A1)-1)=0,"",OFFSET(INDIRECT($B3&"!h8"),,COLUMNS($A$1:A1)-1)) الملف مرفق 220_s.xlsx

تمت الاجابة على هذا العنوان

لا يمكن العمل على ملف 4.5 ميغا بسهولة الرجاء تحميل ملف مختصر (لا أكثر من 10 صفوف) لمتابعة سير عمل المعادلات

النجمة قبل C$1& تعني C$1 مسبوقة بأي حرف او فراغ النجمة بعد C$1& تعني اي حرف او فراغ بعد C$1 ممكن معادلة ثانية لنفس الملف هذه المعادلة توضع في الخلية C2 وتسحب يسارا ثم نزولاً =IF(NOT(ISERROR(FIND(C$1,$B2))),C$1,"")

جرب هذا الكود Option Explicit Sub Give_Data() Dim Dic As Object Dim i%, Itm, k Dim max_ro%, Laste_Row% Dim Sh As Worksheet 'source_sheet (Main) Dim Th As Worksheet ' Target_sheet (Repport) Set Sh = Sheets("Main"): Set Th = Sheets("Repport") max_ro = Th.Cells(Rows.Count, 1).End(3).Row If max_ro = 1 Then max_ro = 2 Th.Range("a2:b" & max_ro).ClearContents Laste_Row = Sh.Cells(Rows.Count, 1).End(3).Row If Laste_Row < 2 Then MsgBox "No Data" Exit Sub End If Set Dic = CreateObject("Scripting.Dictionary") With Dic For i = 2 To Laste_Row If Sh.Range("B" & i) <> vbNullString Then k = Sh.Range("B" & i) Itm = Sh.Range("D" & i) - Sh.Range("C" & i) If Not .Exists(k) Then .Add k, Itm Else Dic(k) = Dic(k) + Itm End If End If Next i Th.Range("A2").Resize(.Count, 1) = Application.Transpose(.keys) Th.Range("B2").Resize(.Count, 1) = Application.Transpose(.Items) End With '=============== Dic.RemoveAll: Set Dic = Nothing End Sub الملف مرفق Exemple.xlsm

جرب هذه المعادلة في العامود V =MOD(SUM(P4,R4,T4)+1,1) وهذه في العامود X =QUOTIENT(SUM(P4,R4,T4,V4)-MOD(SUM(P4,R4,T4)+1,1),1) File Included Ternm.xls

جرب هذا الملف ouvriers.xlsx

لا أعلم اذا كان هذا ما تريد (في الغمود M) =1-MOD(SUM($J4:$L4),1) (في الغمود N) =SUM($J4:$M4) (في الغمود O) =SUM($C4,-(SUM($J4:$M4))) file included DAM8A.xlsx

مع أني لا أطيق اليورز فورم ولا أحب التعامل معه اليك هذا الكود أسرع بكثير Private Sub CommandButton1_Click() Dim ws As Worksheet Dim find_rg As Range Dim Ro%, i% For Each ws In ThisWorkbook.Worksheets Set find_rg = ws.Range("a5:a800").Find(TextBox1.Text) If Not find_rg Is Nothing Then Ro = find_rg.Row For i = 2 To 11 ws.Cells(Ro, i) = Me.Controls("TextBox" & i).Value Next End If Next ws For i = 1 To 11 Me.Controls("TextBox" & i) = vbNullString Next MsgBox "تم تعديل البيانات بنجاح" End Sub الملف Saecch_By_User.xlsm

شاهد هذا الفيديو https://www.youtube.com/watch?time_continue=2&v=IBq92g7gGBE

تم التعديل Salim_المطلوب - new.xlsm