نجوم المشاركات

وعليكم السلام ..تفضل أرجو أن يكون المطلوب تحريك الصف العلوي والسفلي.xlsm

وعليكم السلام ..قم أولاً بتحويل تنسيق الأرقام إلى رقم لأنها منسقة على شكل نص من V9:V15 أو اضرب قيمة كل خلية بـ 1 أما القيم الرقمية في العمود .AC9:AE15 استبدل كلمة دائن بفراغ وحوله إلى رقم ..أو استخدم المعادلة التالية: =SUBSTITUTE(AC9;"دائن";"") نموذج اوفيسنا.xlsx

السلام عليكم أخي الكريم من تبويب DATA: Text to Columns << ثم Next تختار Comma تقبل تحياتي.

شكرا جزيلا أستاذ محمد حسن المحمد فعلا هذا ما أريده جزاك الله خيرا وجعله الله في ميزان حسناتكم وزادكم الله من علمه وفضله . والشكر موصول أيضا للأستاذ عبدالفتاح على محاولته مساعدتي . فالغرض من تحريك الجدول هو لاغلاق الجدول بنهاية آخر اسم في الكشف زادت الاسماء أو قلت.،فشكرا جزيلا مرة ثانية .

الحمد لله الذي بنعمته تتم الصالحات

وعليكم السلام ورحمة الله وبركاته ..شكراً شكراً شكراً على هذه الإفادة ..جزاك الله خير ورفع الله قدرك..الله يحفظك ويرعاك

تفضل اخي المشكلة في تنسيق الخلايا ليس اكثر تم تعديل الملف اطفال_MH-3.xlsm

السلام عليكم ورحمة الله وبركاته.. من المعروف ان الواتس اب يسمح لك بارسال 5 رسائل فقط في كل مرة يعني لو كان لدينا 15 شخص نريد ان نرسل له رسالة علينا ان نقوم باعادة توجيه الرسالة 3 مرات كل مرة 5 اشخاص.. قمت بعمل اداة صغيرة في الـ NET. لتقوم بهذه المهمة. صورة مشروع الاكسس: قم بتحديد الاشخاص الذين تريد ارسال الرسالة لهم مع وضع نص الرسالة مع امكانية تحديد الكل يمكنك شروط البرنامج بحسب ماتراه مناسباً. النتيجة: ملاحظة يجب ان يكون برنامج الواتس اب موجود في جهاز الكومبيوتر واهم ملاحظة هي يجب كتاب رقم الواتس اب الذي تريد ان ترسل له الرسالة كما يظهر في البرنامج، مثال: لتحميل الواتس اب من الرابط الاتي: https://www.whatsapp.com/download لا تنسوني ووالدي من صالح دعائكم. تم بحمد الله. Whatsapp-Message-Sender.rar

السلام عليكم ورحمة الله وبركاته ..الاخوة الكرام لدي مشكلة في شيت اكسيل تم تحميله من البنك لا استطيع جمع الارقام فيه الرجاء مساعدتي في كيفية حل المشكلة وشرح الطريقة حتى استطيع حلها في باقي الملفات ..كل الشكر والتقدير للكل نموذج اوفيسنا.xlsx

السلام عليكم و رحمة الله جرب هذا الكود Sub ConTxtNum() Dim ws As Worksheet, C As Range Dim i As Long, j As Long Dim Arr, Tmp, Txt As String Set ws = Sheets("Sheet1") Application.ScreenUpdating = False For Each C In ws.Range("K6:K" & ws.Range("K" & Rows.Count).End(3).Row) For i = 1 To Len(C) Txt = Mid(C, i, 1) If Txt Like "[0-9]" Or Txt = "0" Then Arr = Arr & Txt Else Arr = Arr & " " End If Next Arr = Application.WorksheetFunction.Trim(Arr) Tmp = Split(Arr, " ") For j = 0 To UBound(Tmp) C.Offset(0, j + 2) = Tmp(j) Arr = "" Next Next Application.ScreenUpdating = True End Sub

اخي الفاضل نكمل خطوة خطوة وان شاء الله سوف يتم المطلوب اولا هل هدا هو الشكل النهائي لليوزرفورم تم ترتيب الاعمدة على حسب ما جاء في الشرح داخل الملف وادا كان هناك تغيير اشر اليه

السلام عليكم ورحمة الله تعالى وبركاته جرب اخي انشاء مجلد في اي مكان على الجهاز وقم بوضع الملف بداخله ثم اضف الكود التالي Sub convert_to_CSV() Dim st As Worksheet Dim path As String Application.ScreenUpdating = False path = ActiveWorkbook.path & "\" & Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) For Each st In Worksheets st.Copy ActiveWorkbook.SaveAs Filename:=path & "_" & st.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False ActiveWorkbook.Close False Next Application.ScreenUpdating = True End Sub اليك الملف عليه الكود كما سبق الدكر ضعه في مجلد منفضل وقم بتشغيل الكود بالتوفيق..... ملف الاكسيل المحول من وورد.xlsm

السلام عليكم ورحمة الله وبركاته..الأخوة الأعزاء ..تحية طيبة هل من طريقة بحيث يكون الجدول السلفي الذي به التوقيع يتحرك إلى الأعلى أوينزل إلى الأسفل حسب بيانات الجدول العلوي ، فإن كان تعبئة بيانات الجدول العلوي الى الصف رقم 8 يتحرك الجدول السلفي إلى أعلى ليكون بدايته الصف رقم 9 ، وإن كان نهايته الصف رقم 14 ينزل الجدول السفلي ليكون بدايته من الصف 15 وهكذا ، أتمنى أن تكون الفكرة واضحة . ..تــــم إعادة رفع الملف بدون ضغط لأنه حجمه صغير تجنباً لإهدار وقت الأساتذة تحريك الصف العلوي والسفلي.xlsx

@Muner انا لم اجد اي منفعة مما تطلبه . ما الغرض منه ؟؟ الطريقة المثلى هو ان تضع الجدول في الاسفل ابتداء من الصف السابع اذا كنت تريد عمل فاصل بين الجدولين اما الجدول الاول لا يوجد صفوف فارغة فقط تحدد اخر خلية معبئة في العمود F ومن تم انتر فيدرج لك الصف الذي تحتاجه في كل مرة تكرر العملية على حسب احتياجك من الصفوف.

السلام عليكم ورحمة الله وبركاته عندي أرقام ألصقتها في الاكسل وصارت في خلية واحدة واحتاج يكون كل خلية فيها رقم .. عشان أقدر أزيل رقم الجوال المكرر !! مرفق صورة حيث بين كل رقم ورقم فاصل

=IF(IF(NB.SI($B$1:B2;B2)=1;MAX($A1:A$1)+1;"")<>"";SI(NB.SI($B$1:B2;B2)=1;MAX($A1:A$1)+1;"");INDEX($A$1:A1;EQUIV(B2;$B$1:B2;0))) تفضل جرب اخي OfficinaExample(3).xlsx

السلام عليكم ورحمة الله تعالى وبركاته نعم اخي الفاضل اتضحت الفكرة وللعلم اخي الفاضل استوعاب الفكرة وفهم المطلوب يمثل 90 في المئة من الحل .وهدا ما يجعلني لا اخوض في كثير من المداخلات بسبب عدم شرح السائل لطلبه جيدا او وضع نمودج للنتائج المتوقعة . على العموم اتمنى ان اكون قد استوعبت طلبك اخي الكريم 😁 اليك كودين ولك الاختيار هدا كود لنقل البيانات من الاعمدة الى الصفوف حسب الرمز المكرر من شيت اطفال الى شيت اخر (DATA ) Sub Transpose_to_columns() Dim inp_arr, i As Long, out_arr, dict As Object, key As String Set dict = CreateObject("Scripting.Dictionary") With Sheets("اطفال") inp_arr = .Range(.Cells(2, 5), .Cells(.Rows.Count, 1).End(xlUp)).Value End With For i = 1 To UBound(inp_arr) key = CStr(inp_arr(i, 1)) If dict.Exists(key) Then dict(key) = dict(key) & ";" & inp_arr(i, 3) & ";" & inp_arr(i, 4) & ";" & inp_arr(i, 5) Else dict.Add key, inp_arr(i, 3) & ";" & inp_arr(i, 4) & ";" & inp_arr(i, 5) End If Next i ReDim out_arr(1 To dict.Count, 1 To 4) For i = 0 To dict.Count - 1 out_arr(i + 1, 1) = dict.Keys()(i) out_arr(i + 1, 2) = dict.Items()(i) Next i With Sheets("data") .Cells(2, 1).Resize(dict.Count, 2) = out_arr .Cells(2, 2).Resize(dict.Count, 1).TextToColumns Destination:=.Cells(2, 2), DataType:=xlDelimited, Semicolon:=True End With Set dict = Nothing Sheets("data").Activate End Sub وهدا كود لنقل البيانات من الاعمدة الى الصفوف حسب الرمز المكرر في نفس الشيت (اطفال) Sub MH_transpose_colmns() Dim der, t, ref, nbr&, i&, i1&, i2& Application.ScreenUpdating = False With ActiveSheet If .FilterMode Then .ShowAllData der = Cells(Rows.Count, "a").End(xlUp).Row Columns("a:e").Resize(der).Sort key1:=Range("a1"), order1:=xlAscending, _ key2:=Range("b1"), order2:=xlAscending, Header:=xlYes t = Columns("a:e").Resize(der + 1).Value2 ReDim r(1 To 1, 1 To Columns.Count - Range("h1").Column - 1) Range(Range("h1"), Cells(Rows.Count, Columns.Count)).Clear ref = t(2, 1): i1 = 2: i2 = i1: nbr = 1: r(1, nbr) = ref Do If t(i2, 1) = ref Then nbr = nbr + 1: r(1, nbr) = t(i2, 3) nbr = nbr + 1: r(1, nbr) = t(i2, 4) nbr = nbr + 1: r(1, nbr) = t(i2, 5) i2 = i2 + 1 Else Cells(Rows.Count, "h").End(xlUp).Offset(1).Resize(, nbr) = r ReDim r(1 To 1, 1 To Columns.Count - Range("h2").Column - 1) i1 = i2: i2 = i1: ref = t(i2, 1): nbr = 1: r(1, nbr) = ref If ref = "" Then Exit Do End If Loop End With Application.ScreenUpdating = True End Sub واليك الملف مع اضافة الاكواد ....في حالة الرغبة في الاضافة او التعديل لا تتردد اخي الكريم.بالتوفيق ... اطفال_MH.xlsm