أكاديمية الصقر للتدريب

اعلان هنا
ألعاب فلاش أون لاين
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا




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


الرئيسية
نتائج البحث


نتائج البحث عن ردود العضو :salim
عدد النتائج (334) نتيجة
08-08-2019 10:56 مساء
icon كود عرض القيم الملونة لعمود معين في الليست بوكس | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 نفس الموضوع على هذا العنوان
لماذا يا ترى؟؟؟؟؟؟
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
08-08-2019 12:10 صباحا
icon الترحيل المبعثر حسب اسم الصفحه | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 ومن قال لك اني استهترت بالكود الذي وضعته يا استاذ محمود
حقيقة كان لي هذا الرأي قبل  ان اجربه وقد تبين لي اني كنت مخطئا
لذا ارجو المعذرة 
07-08-2019 10:13 مساء
icon الترحيل المبعثر حسب اسم الصفحه | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 تبين ان هناك خطأ بسيط في الكود تمت معالجته
الكود الجديد

Option Explicit
Option Base 1

Sub taransfer_data_New()
Dim i%, k%, Max_row, x%
Dim arr_from, arr_to, arr_sh
Dim Rg_Filter As Range
Set Rg_Filter = Sheets("data").Range("b2").CurrentRegion
Max_row = Rg_Filter.Rows.Count
arr_from = Array(3, 6, 9, 10, 12, 23, 13, 14, 15)
arr_to = Array(2, 3, 5, 6, 7, 8, 9, 10, 11)
ReDim arr_sh(Worksheets.Count - 1)

 For i = 2 To Sheets.Count
    arr_sh(i - 1) = Sheets(i).Name
    Sheets(i).Range("a3").Resize(1000, 11).Clear
 Next

For k = LBound(arr_sh) To UBound(arr_sh)
    Rg_Filter.AutoFilter 6, Sheets(arr_sh(k)).Name
     
        For x = LBound(arr_to) To UBound(arr_to)
          Rg_Filter.Columns(arr_from(x)).Offset(1) _
          .Resize(Max_row - 1).SpecialCells(12).Copy _
          Sheets(arr_sh(k)).Cells(3, arr_to(x))
         Next
 Next
 If Sheets("data").FilterMode Then
   Range("b2").AutoFilter
 End If
End Sub


الملف الجديد
 
07-08-2019 09:42 مساء
icon الترحيل المبعثر حسب اسم الصفحه | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
المشاركة الأصلية كتبت بواسطة: محمود ابو الدهب
المشاركة الأصلية كتبت بواسطة: salim
المشاركة الأصلية كتبت بواسطة: عبدالرحمن صبحى
جزاك الله خيرا  على اهتمامك استاذ سليم ،
الكود بالفعل قد نجح معى ولاكن لماذا لا يتم ترحيل كل البيانات ،هل هناك جزء فى الكود استطيع تغيره ليتم ترحيل البيانات المفلتره كلها ،حيث ان الكود صعب شويه على واحد مبتدئ مثلى فيه دوال أول مره تعدى عليا ومش عااارف اغير اى حاجه فى الكود .
وجزاك الله خيرا 
 

من المفروض ان ترحل كل البيانات الا اذا كان هناك مسافة ناقصة او زائدة في الاسم
مثلاً "تاجر" يمكن ان تكون مكتوبة بأحد الصفوف " تاجر" مع مسافة زائدة قبل  حرف التاء  او "تاجــر"
بعبارة اخرى الاسم غير مطابق تماماً لاسم الشيت

لذلك اقترح ادراج الاسماء من خلال قوائم منسدلة 
يمكن ان يكون هناك سبب اخر وهو وجود فراغات في الجدول
 


راجع الكود استاذى العزيز اعتقد انه لم تكن تلك هى المشكلة بالاسم.
بالاسم متطابق في الحالتين والدليل على ذالك عند عمل تصفيه لكلمة تاجر ستجد ان الاعمدة الظاهرة تصل مثلا الى 150 اسم انما ما يتم ترحيلة لا يتعدى 5 او 6
 

لا تنس اني في الملف الذي رفعته لم اضع كل البيانات بل وضعت جدولاَ مختصراً من حوالي 100 صف فقط للاطلاع على كيفية تنفيذ الكود
07-08-2019 07:48 مساء
icon الترحيل المبعثر حسب اسم الصفحه | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
المشاركة الأصلية كتبت بواسطة: محمود ابو الدهب
الحمد لله على تمام الامر  وشكرا لك على كلماتك الطيبة
 

استاذ محمود 
كود جميل لجدول من 50 او 60 صف
لكن يرهق البرنامج اذا كان هناك اكثر من 1000 صف في الجول
تصور انك تجري حلقلة تكرارية على 1000 صف واكثر اربع مرات(عدد الشيتات المنقولة اليها البيانات)
وداخل كل صف استخراج ما يمكن استخراجه (بعد الجولة على الاعمدة)

فما بالك اذا كان هناك ليس اربع شيتات فقط بل 50 والجدول مؤلف من 8000 صف مثلاً

اي  سيقوم الكود  بجرد كل الجدول من أوله الى اخره صفاً بعد صف 
اعتقد ان استعمال الفلتر في هذه الحالة اسرع بكثير
07-08-2019 07:35 مساء
icon الترحيل المبعثر حسب اسم الصفحه | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
المشاركة الأصلية كتبت بواسطة: عبدالرحمن صبحى
جزاك الله خيرا  على اهتمامك استاذ سليم ،
الكود بالفعل قد نجح معى ولاكن لماذا لا يتم ترحيل كل البيانات ،هل هناك جزء فى الكود استطيع تغيره ليتم ترحيل البيانات المفلتره كلها ،حيث ان الكود صعب شويه على واحد مبتدئ مثلى فيه دوال أول مره تعدى عليا ومش عااارف اغير اى حاجه فى الكود .
وجزاك الله خيرا 
 

من المفروض ان ترحل كل البيانات الا اذا كان هناك مسافة ناقصة او زائدة في الاسم
مثلاً "تاجر" يمكن ان تكون مكتوبة بأحد الصفوف " تاجر" مع مسافة زائدة قبل  حرف التاء  او "تاجــر"
بعبارة اخرى الاسم غير مطابق تماماً لاسم الشيت

لذلك اقترح ادراج الاسماء من خلال قوائم منسدلة 
يمكن ان يكون هناك سبب اخر وهو وجود فراغات في الجدول
 
07-08-2019 04:14 مساء
icon الترحيل المبعثر حسب اسم الصفحه | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود

Option Explicit
Option Base 1

Sub taransfer_data()
Dim i%, k%, Max_row, x%
Dim arr_from, arr_to, arr_sh
Dim Rg_Filter As Range
Set Rg_Filter = Sheets("data").Range("b2").CurrentRegion
Max_row = Rg_Filter.Rows.Count
arr_from = Array(3, 6, 9, 10, 12, 23, 13, 14, 15)
arr_to = Array(2, 3, 5, 6, 7, 8, 9, 10, 11)
ReDim arr_sh(Worksheets.Count - 1)

 For i = 2 To Sheets.Count
    arr_sh(i - 1) = Sheets(i).Name
    Sheets(i).Range("a3").Resize(1000, 11).Clear
 Next
 
For k = LBound(arr_sh) To UBound(arr_sh)
    Rg_Filter.AutoFilter 6, Sheets(arr_sh(k)).Name
      With Rg_Filter.Offset(1).Resize(Max_row - 1).SpecialCells(12)
         For x = LBound(arr_to) To UBound(arr_to)
          .Columns(arr_from(x)).Copy _
           Sheets(arr_sh(k)).Cells(3, arr_to(x))
         Next
      End With
 Next
 If Sheets("data").FilterMode Then
   Range("b2").AutoFilter
 End If
End Sub


الملف مرفق
07-08-2019 02:58 مساء
icon الترحيل المبعثر حسب اسم الصفحه | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
المشاركة الأصلية كتبت بواسطة: عبدالرحمن صبحى
السلام عليكم ورحمة الله .

مرفق ملف به ٤ صفحات للتجربه فقط  ،

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

فى الملف الخاص بى الصفحات فيه بإسم العملاء كثيره عشان متقفلش الكود على ٣ صفحات بس .
 
وجزاكم الله خيرا .

و من اين احصل على كود الفاتوره حيث انه غير موجود في الجدول الرئيسي
04-08-2019 06:34 مساء
icon تجزئة الاسماء المركبة وفصلها عن الاسماء العادية | الكاتب :salim |المنتدى: اكسيل شروحات ودروس
 
المشاركة الأصلية كتبت بواسطة: محسن أحمد عبد الرازق

أساتذتى الأعزاء أرجو توضيح أين يتم وضع الكود وكيفية حفظه فأنا خبرتى بالأكواد منعدمة  
أنا أضغط alt + f11  تفتح مكان الكود بعد ذلك معرفش أعمل إيه كى أستخرج أسم الأب فى ملفات التقدم للمدرسة
أرجو الشرح بإستفاضة حتى أفهم الموضوع


شاهد هذا الفيديو
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب


31-07-2019 08:38 صباحا
icon مساعده في تعديل كودات اكسل للأهمية | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 بالنسبة للأزرار تم عمل الأكودد اللازمة

Option Explicit
Private Sub CommandButton1_Click()
add_for_me
End Sub
Rem +++++++++++++++++++++++++++++++++
Private Sub CommandButton2_Click()
del_info
End Sub

Rem ++++++++++++++++++++++++++++++++++++++
 Sub add_for_me()
    Dim x%, i%, Se#, Sf#, Sg#, Sh#, Si#

   For i = 2 To 10
     If Cells(i, 2) = vbNullString Then GoTo Next_I
     Se = IIf(IsNumeric(Cells(i, "E")), Cells(i, "E"), 0)
     Sf = IIf(IsNumeric(Cells(i, "F")), Cells(i, "F"), 0)
     Sg = IIf(IsNumeric(Cells(i, "G")), Cells(i, "G"), 0)
     Sh = IIf(IsNumeric(Cells(i, "H")), Cells(i, "H"), 0)
     Si = IIf(IsNumeric(Cells(i, "I")), Cells(i, "I"), 0)
     
    For x = i + 1 To 10
     If Cells(x, 2) = vbNullString Then GoTo Next_X
      If Cells(i, 2) = Cells(x, 2) Then
        Se = IIf(IsNumeric(Cells(x, "E")), Se + Cells(x, "E"), Se)
        Sf = IIf(IsNumeric(Cells(x, "F")), Sf + Cells(x, "F"), Sf)
        Sg = IIf(IsNumeric(Cells(x, "G")), Sg + Cells(x, "G"), Sg)
        Sh = IIf(IsNumeric(Cells(x, "H")), Sh + Cells(x, "H"), Sh)
        Si = IIf(IsNumeric(Cells(x, "I")), Si + Cells(x, "I"), Si)
      End If
      
Next_X:
     Next x
      Cells(i, "E") = Se: Cells(i, "F") = Sf: Cells(i, "G") = Sg
      Cells(i, "H") = Sh: Cells(i, "I") = Si
Next_I:
       Se = 0: Sf = 0: Sg = 0: Sh = 0: Si = 0
     Next i

End Sub
Rem++++++++++++++++++++++++++++++++++++++++++++++
Sub del_info()
Dim t%, y%, cnt%
y = 11
For t = 2 To y
 If Range("B" & t) = vbNullString Then GoTo Next_t
 cnt = Application.CountIf(Range("B2:B" & t), Range("B" & t))
 If cnt > 1 Then
 Range("b" & t).Resize(, 11).ClearContents
 End If
Next_t:
 Next
End Sub
Rem+++++++++++++++++++++++++++++++++++++


الملف مرفق

 
30-07-2019 05:40 مساء
icon كشف حساب بدون تكرار بيانات | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 بعد اذن الاخ ياسر 
الملف نفسه لكن بالمعادلات مع تجديد للقائمة المنسدلة كلما حدث شيئاً جديداً بالجدول الرئيسي
هناك معادلة مهمة بالشيت   Data العامود  K  يعتمد استخراج المطلوب عليها
(العامود مخفي لعدم العبث به عن طرق الخطأ)
كان يمكن ادراجها بالكود لكن لم افعل لضيق الوقت يرجى الاطلاع عليها
الملف مرفق
 
30-07-2019 11:37 صباحا
icon كشف حساب بدون تكرار بيانات | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 انا اقترح هذا الكود (بمجرد كتابة الاسم في الخلية  يقوم الماكرو بعمله)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$F$2" And Target.Count = 1 Then
give_data
End If
Application.EnableEvents = True
End Sub
'=====================================
Sub give_data()
Dim Tabl As Range
Range("a4").CurrentRegion.Clear
Set Tabl = Sheets("data").Range("B3").CurrentRegion
Tabl.AutoFilter 5, Range("f2")
Tabl.SpecialCells(12).Copy Range("a4")
End Sub

الملف مرفق

الصفحة 1 من 28 < 1 2 3 4 28 > الأخيرة »





الساعة الآن 02:17 صباحا

أعلن هنا
أعلن هنا
أعلن هنا