بحث مخصص من جوجل فى أوفيسنا
Custom Search
|
سليم حاصبيا
أوفيسنا-
Posts
8,723 -
تاريخ الانضمام
-
Days Won
262
سليم حاصبيا last won the day on أغسطس 1 2023
سليم حاصبيا had the most liked content!
السمعه بالموقع
8,577 Excellentعن العضو سليم حاصبيا
- تاريخ الميلاد 08 مار, 1985
البيانات الشخصية
-
Gender (Ar)
ذكر
-
Job Title
استاذ ثانوي
-
البلد
beiruth
-
الإهتمامات
eXCEL
اخر الزوار
-
waelshaheen1976 started following سليم حاصبيا
-
Ahmedbakheet started following سليم حاصبيا
-
jamal2080 started following سليم حاصبيا
-
Elhacker started following سليم حاصبيا
-
المشرفي started following سليم حاصبيا
-
amalbesheer started following سليم حاصبيا
-
محمد حسن المحمد started following سليم حاصبيا
-
yafayafa started following سليم حاصبيا
-
Reda Mohammad started following سليم حاصبيا
-
KHALED SLEEM started following سليم حاصبيا
-
طلب معادلة لضرب قيم مختلفة فى نسبة مئوية مختلفة
سليم حاصبيا replied to ناصرالمصرى's topic in منتدى الاكسيل Excel
-
كشف حساب (الدائن - المدين) لكل عميل
سليم حاصبيا replied to طارق منصور's topic in منتدى الاكسيل Excel
حرب هذا الملف لا ضرورة لادراج اكثر من 700 صف لان المكرو الذي يعمل على صف واجد يستطيع العمل على الألوف منها يكفي ادراج نموذح بسيط لما تريد (50 صف كحد أقصى) كما اني لم أفهم ما هي الحاجة الى اليوزر فورم؟؟؟ Option Explicit Sub Get_data() Dim H As Worksheet Dim T As Worksheet Dim LrH%, LrT%, i%, Sd#, _ k%, Se#, My_val#, n% Dim Date1 As Date, Date2 As Date Dim M_date As Date, X_date As Date Dim Fr As Range, Wat As Range, Ro1%, Ro2% Dim x As Boolean, y As Boolean Set H = Sheets("Haraka") Set T = Sheets("Takrir") LrH = H.Cells(Rows.Count, 1).End(3).Row LrT = 20 T.Range("D5").Resize(LrT, 3).ClearContents Date1 = Application.Min(H.Range("C4:C" & LrH)) Date2 = Application.Max(H.Range("C4:C" & LrH)) If Not IsDate(T.Range("D2")) Or Not IsDate(T.Range("E2")) Then MsgBox "Please Type Dates in D2 and E2" Exit Sub End If M_date = T.Range("D2"): X_date = T.Range("E2") If Not IsDate(T.Range("D2")) Or Not IsDate(T.Range("E2")) Then MsgBox "Wrong Dates" Exit Sub End If T.Range("D2") = Application.Min(M_date, X_date) T.Range("E2") = Application.Max(M_date, X_date) M_date = T.Range("D2"): X_date = T.Range("E2") Set Wat = H.Range("A3:A" & LrH) For i = 5 To LrT Set Fr = Wat.Find(T.Range("B" & i), lookat:=1) If Fr Is Nothing Then GoTo Again Ro1 = Fr.Row: Ro2 = Ro1 Do x = H.Range("C" & Ro2) >= M_date y = H.Range("C" & Ro2) <= X_date If x And y Then Sd = Sd + Val(H.Range("D" & Ro2)) Se = Se + Val(H.Range("E" & Ro2)) n = n + 1 End If Set Fr = Wat.FindNext(Fr) Ro2 = Fr.Row If Ro2 = Ro1 Then Exit Do Loop T.Range("D" & i) = IIf(Sd = 0, "", Sd) T.Range("E" & i) = IIf(Se = 0, "", Se) My_val = Val(T.Range("C" & i)) + Val(T.Range("D" & i)) _ - Val(T.Range("E" & i)) T.Range("F" & i) = IIf(My_val = 0, "", My_val) T.Range("G" & i) = IIf(n = 0, "", n) Again: Sd = 0: Se = 0: n = 0 Next i End Sub T_Mansour.xlsm- 1 reply
-
- 5
-
طلب معادلة لضرب قيم مختلفة فى نسبة مئوية مختلفة
سليم حاصبيا replied to ناصرالمصرى's topic in منتدى الاكسيل Excel
نموذج عما تريده Naser_Masry.xlsx -
اريد عمل جدول عائلة الكلمات في اللغة الانجليزية
سليم حاصبيا replied to علي الهتاري's topic in منتدى الاكسيل Excel
-
اريد عمل جدول عائلة الكلمات في اللغة الانجليزية
سليم حاصبيا replied to علي الهتاري's topic in منتدى الاكسيل Excel
اذا كان ما فهمته صحيحاً هذا الكود (فقط اضغط الزر Run) Option Explicit Sub Creezy_sort() Dim CoL As Object Dim Lr%, i%, x% Dim arr Dim Ws As Worksheet Set Ws = Sheets("EN") With Ws .Range("E1").CurrentRegion.Offset(1).ClearContents Set CoL = CreateObject("System.Collections.sortedlist") Lr = .Cells(Rows.Count, 1).End(3).Row For i = 2 To Lr CoL.Add Len(.Cells(i, 1)) + i / 1000, .Cells(i, 1) & _ "*" & .Cells(i, 2) Next i x = 2 For i = 0 To CoL.Count - 1 .Cells(x, "E") = Split(CoL.GetByIndex(i), "*")(0) .Cells(x, "F") = Split(CoL.GetByIndex(i), "*")(1) arr = Split(Split(CoL.GetByIndex(i), "*")(1), ",") .Cells(x, "G") = UBound(arr) + 1 x = x + 1 Next End With Set Ws = Nothing: Set CoL = Nothing End Sub الملف مرفق Hitari.xlsm -
كود استدعاء بيانات حسب الشهر والسنة
سليم حاصبيا replied to محمد عبد الناصر's topic in منتدى الاكسيل Excel
بعد اذن الاستاذ إبراهيم هذا الكود Option Explicit Sub My_Repport() Dim Mh As Range, Single_Cel As Range Dim Y%, M%, i%, x% Dim My_Months(), Arr_Year() x = 6 Takrir.Range("A5").CurrentRegion.Offset(1).ClearContents Arr_Year = Array(2020, 2021, 2022, 2023, 2024, 2025) My_Months = Array("يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", _ "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") If IsError(Application.Match( _ Takrir.Range("B3"), Arr_Year, 0)) Then Exit Sub If IsError(Application.Match( _ Takrir.Range("A3"), My_Months, 0)) Then Exit Sub Set Mh = Mahmoud.Range("A5").CurrentRegion.Columns(2) Y = Takrir.Range("B3") M = Application.Match(Takrir.Range("A3"), My_Months, 0) For Each Single_Cel In Mh.Cells If IsDate(Single_Cel) And Month(Single_Cel) = M _ And Year(Single_Cel) = Y Then Takrir.Range("A" & x).Resize(, 5).Value = _ Single_Cel.Offset(, -1).Resize(, 5).Value x = x + 1 End If Next Single_Cel End Sub الملف مرفق Naser_data.xlsm -
Try This File Jalal.xlsx
-
فقط تغيير المعطيات Option Explicit '++++++++++++++++++++++++++++++ Dim Ra As Range, Rb As Range Dim a%, b%, i%, Bol As Boolean Dim m%, t% Dim Ky Dim S As Worksheet Dim Dic_Unique As Object Dim Dic As Object '++++++++++++++++++++++++++++++++++++++ Sub Item_Unique() Set S = Sheets("Salim") Set Dic = CreateObject("Scripting.Dictionary") Set Dic_Unique = CreateObject("Scripting.Dictionary") a = S.Cells(Rows.Count, 1).End(3).Row b = S.Cells(Rows.Count, 2).End(3).Row Set Ra = S.Range("A2:A" & a) Set Rb = Range("B2:B" & b) For i = 2 To b Dic_Unique(S.Cells(i, 2).Value) = "" Next End Sub '""""""""""""""""""""""""""""""""""""""""""" Sub ExtractB() Item_Unique S.Range("K2").CurrentRegion.Offset(1).ClearContents If Dic_Unique.Count Then For Each Ky In Dic_Unique.keys Bol = IsError(Application.Match(Ky, Ra, 0)) If Bol Then Dic(Ky) = 1 Else Dic(Ky) = Application.CountIf(Rb, Ky) - 1 End If Next Ky End If If Dic.Count Then m = 2 For Each Ky In Dic.keys If Dic(Ky) <> 0 Then S.Range("K" & m).Resize(Dic(Ky)) = Ky m = m + Dic(Ky) End If Next t = S.Range("k2").CurrentRegion.Rows.Count If t > 1 Then S.Range("L2") = t - 1 S.Range("J2").Resize(t - 1).Value = _ Evaluate("Row(1:" & t - 1 & ")") End If End If Set S = Nothing Set Ra = Nothing: Set Rb = Nothing Set Dic_Unique = Nothing Set Dic = Nothing End Sub الملف مرفق Alla_20_4.xlsm
-
كود نقل اصفف على حسب اسم الشهر
سليم حاصبيا replied to محمد عبد الناصر's topic in منتدى الاكسيل Excel
<رب هذا الملف Sub each_row_to_Its_sheet() Dim lr, i, x Dim sh As Worksheet Sheets("jan").Range("a2").CurrentRegion.Offset(1).ClearContents Sheets("Feb").Range("a2").CurrentRegion.Offset(1).ClearContents Sheets("Mar").Range("a2").CurrentRegion.Offset(1).ClearContents With Sheets("Legal") lr = .Cells(Rows.Count, 1).End(3).Row For i = 3 To lr If Not IsDate(.Cells(i, 2)) Then GoTo next_i Select Case Month(.Cells(i, 2)) Case 1: Set sh = Sheets("jan") Case 2: Set sh = Sheets("Feb") Case 3: Set sh = Sheets("Mar") Case Else: GoTo next_i End Select x = sh.Cells(Rows.Count, 1).End(3).Row + 1 sh.Cells(x, 1).Resize(, 5).Value = _ .Cells(i, 1).Resize(, 5).Value next_i: Next i End With End Sub الملف مرفق Naser.xlsm -
الكود المطلوب Private Sub TextBox27_Change() Dim bol As Boolean If TextBox27.Value <> "" Then ListBox1.Visible = True Else ListBox1.Visible = False End If Dim x As Worksheet Dim c As Range ListBox1.Clear k = 0 For i = 1 To 26 Controls("TextBox" & i).Text = "" Next i If TextBox27 = "" Then Exit Sub bol = Me.OptionButton1 = True If bol Then For Each x In ThisWorkbook.Worksheets SS = x.Cells(Rows.Count, 2).End(xlUp).Row For Each c In x.Range("B2:B" & SS) If Trim(c) Like TextBox27 & "*" Then ListBox1.AddItem ListBox1.List(k, 0) = x.Cells(c.Row, 2) ListBox1.List(k, 1) = c.Worksheet.Name ListBox1.List(k, 2) = c.Row ListBox1.List(k, 3) = x.Name k = k + 1 End If Next c Next x Else For Each x In ThisWorkbook.Worksheets SS = x.Cells(Rows.Count, 2).End(xlUp).Row For Each c In x.Range("B2:B" & SS) If Trim(c) Like "*" & TextBox27 & "*" Then ListBox1.AddItem ListBox1.List(k, 0) = x.Cells(c.Row, 2) ListBox1.List(k, 1) = c.Worksheet.Name ListBox1.List(k, 2) = c.Row ListBox1.List(k, 3) = x.Name k = k + 1 End If Next c Next x End If End Sub الملف مرفق Allaq_User.xlsm
-
التعديل على الكود كما تريد Option Explicit '++++++++++++++++++++++++++++++ Dim Ra As Range, Rb As Range Dim a%, b%, i%, Bol As Boolean Dim m%, t% Dim Ky Dim S As Worksheet Dim Dic_Unique As Object Dim Dic As Object '++++++++++++++++++++++++++++++++++++++ Sub Unique_item() Set S = Sheets("Salim") Set Dic = CreateObject("Scripting.Dictionary") Set Dic_Unique = CreateObject("Scripting.Dictionary") a = S.Cells(Rows.Count, 1).End(3).Row b = S.Cells(Rows.Count, 2).End(3).Row Set Ra = S.Range("A2:A" & a) Set Rb = Range("B2:B" & b) For i = 2 To a Dic_Unique(S.Cells(i, 1).Value) = "" Next End Sub '""""""""""""""""""""""""""""""""""""""""""" Sub Extract() Unique_item S.Range("D2").CurrentRegion.Offset(1).ClearContents If Dic_Unique.Count Then For Each Ky In Dic_Unique.keys Bol = IsError(Application.Match(Ky, Rb, 0)) If Bol Then Dic(Ky) = 1 Else Dic(Ky) = Application.CountIf(Ra, Ky) - 1 End If Next Ky End If If Dic.Count Then m = 2 For Each Ky In Dic.keys If Dic(Ky) <> 0 Then S.Range("E" & m).Resize(Dic(Ky)) = Ky m = m + Dic(Ky) End If Next t = S.Range("D2").CurrentRegion.Rows.Count If t > 1 Then S.Range("F2") = t - 1 S.Range("D2").Resize(t - 1).Value = _ Evaluate("Row(1:" & t - 1 & ")") End If End If Set S = Nothing Set Ra = Nothing: Set Rb = Nothing Set Dic_Unique = Nothing Set Dic = Nothing End Sub الملف من جديد Alla_20_3.xlsm
-
في هذه الحالة الماكرو هو الحل Option Explicit Sub In_A_But_Not_B() Dim Ra As Range, Rb As Range, _ a%, b%, i%, Bol As Boolean Dim Dic As Object With Sheets("Salim") .Range("D2").CurrentRegion.Offset(1).ClearContents a = .Cells(Rows.Count, 1).End(3).Row b = .Cells(Rows.Count, 2).End(3).Row If a < 2 Or b < 2 Then Exit Sub Set Ra = .Range("A2:A" & a) Set Rb = Range("B2:B" & b) Set Dic = CreateObject("Scripting.Dictionary") For i = 2 To a Bol = IsError(Application.Match(.Cells(i, 1), Rb, 0)) If Bol Then Dic(Dic.Count + 1) = .Cells(i, 1).Value End If Next If Dic.Count Then .Range("E2").Resize(Dic.Count) = _ Application.Transpose(Dic.items) .Range("D2").Resize(Dic.Count) = _ Application.Transpose(Dic.keys) .Range("f2") = Dic.Count End If End With End Sub الملف مرفق Alla_20_2.xlsm
-
تم التعديل (الصفخة Salim) Alla_20_1.xlsx