اعلن هنا
أكاديمية الصقر للتدريب
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا



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





المساعدة في كود ترحيل اعمدة غير متجاورة

المطلوب المساعدة بالتعديل على كود ترحيل اعمدة غير متجاورة المرفق بالملف التالي بحيث يتم الصق في اعمدة غير متجاورة بشرط ..



11-12-2017 10:12 مساء
ayman_2000
menu_open
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 04-09-2017
رقم العضوية : 337
المشاركات : 12
الجنس : ذكر
تاريخ الميلاد : 14-5-1963
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 22
الاعجاب : 6
 offline 
المطلوب المساعدة بالتعديل على كود ترحيل اعمدة غير متجاورة المرفق بالملف التالي 
بحيث يتم الصق في اعمدة غير متجاورة بشرط معين







لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  Shon_Mhny_2018.rar   تحميل rar مرات التحميل :(4)
الحجم :(47.695) KB



تم تحرير الموضوع بواسطة :ayman_2000
بتاريخ:11-12-2017 10:16 مساء







12-12-2017 02:18 صباحا
مشاهدة مشاركة منفردة [1]
محمد الدسوقى
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 47
المشاركات : 360
الجنس : ذكر
تاريخ الميلاد : 14-10-1973
الدعوات : 40
يتابعهم : 7
يتابعونه : 228
قوة السمعة : 2379
الاعجاب : 592
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
الأخ الكريم / ايمن
تفضل الكود التالى لعله يفيد بالغرض
ملحوظة  ... قمت بادراج كود جديد سهل إن شاء الله يفى بالغرض المطلوب
اعتمدت فيه على نطاق مسح البيانات على نفس النطاق الذى أدرجته فى الكود الخاص بك ( يمكن تغييره كما تشاء )
الكود
 Sub Tarheel()

  Dim Arr     As Variant
    Dim i       As Variant
    Dim cr      As Variant
    Dim j       As Long

Dim LR As Long
'----------------------------------
Dim Ws As Worksheet, Sh As Worksheet
Set Sh = Sheets("الشيت")
Set Ws = Sheets("صناعى1")
LR = Sh.Cells(Rows.Count, 7).End(xlUp).Row
'----------------------------------
Application.ScreenUpdating = False

Ws.Range("B13:I4012").ClearContents
Arr = Sh.Range("A5:U" & LR).Value
   
    'الأعمدة المطلوب الترحيل إليها
    cr = Array(2, 4, 8)
    
    'أرقام الأعمدة المطلوب ترحيلها
    For Each i In Array(6, 7, 2)
    
        Sheets("صناعى1").Cells(13, cr(j)).Resize(UBound(Arr, 1)).Value = Application.Index(Arr, , i)
        j = j + 1
    Next i
     
    Application.ScreenUpdating = True
End Sub


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

تقبل تحياتى
 
 
 
  Shon_Mhny_2018.rar   تحميل rar مرات التحميل :(9)
الحجم :(48.831) KB


أثارت هذه المشاركة إعجاب: ayman_2000، الصقر، محمود ابو الدهب،




12-12-2017 06:41 صباحا
مشاهدة مشاركة منفردة [2]
ayman_2000
menu_open
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 04-09-2017
رقم العضوية : 337
المشاركات : 12
الجنس : ذكر
تاريخ الميلاد : 14-5-1963
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 22
الاعجاب : 6
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
[quote=محمد الدسوقى]
الأخ الكريم / ايمن
تفضل الكود التالى لعله يفيد بالغرض
ملحوظة  ... قمت بادراج كود جديد سهل إن شاء الله يفى بالغرض المطلوب
اعتمدت فيه على نطاق مسح البيانات على نفس النطاق الذى أدرجته فى الكود الخاص بك ( يمكن تغييره كما تشاء )
الكود
 Sub Tarheel()

  Dim Arr     As Variant
    Dim i       As Variant
    Dim cr      As Variant
    Dim j       As Long

Dim LR As Long
'----------------------------------
Dim Ws As Worksheet, Sh As Worksheet
Set Sh = Sheets("الشيت")
Set Ws = Sheets("صناعى1")
LR = Sh.Cells(Rows.Count, 7).End(xlUp).Row
'----------------------------------
Application.ScreenUpdating = False

Ws.Range("B13:I4012").ClearContents
Arr = Sh.Range("A5:U" & LR).Value
   
    'الأعمدة المطلوب الترحيل إليها
    cr = Array(2, 4, 8)
    
    'أرقام الأعمدة المطلوب ترحيلها
    For Each i In Array(6, 7, 2)
    
        Sheets("صناعى1").Cells(13, cr(j)).Resize(UBound(Arr, 1)).Value = Application.Index(Arr, , i)
        j = j + 1
    Next i
     
    Application.ScreenUpdating = True
End Sub


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

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


تم تحرير المشاركة بواسطة :ayman_2000
بتاريخ:12-12-2017 06:48 صباحا


أثارت هذه المشاركة إعجاب: محمود ابو الدهب،




13-12-2017 05:19 مساء
مشاهدة مشاركة منفردة [3]
محمود ابو الدهب
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 573
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 56
يتابعهم : 6
يتابعونه : 119
قوة السمعة : 1826
الاعجاب : 664
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
عمل رائع رائع رائع استاذ محمد الدسوقي

ولكن عزرا  ولاننى  مقلد ولست مبدع مثل حضرتك فقد عدلة الكود الخاص به  كالتالى 

Sub AWAEL_1()
 '===========================
'ترحيل
 '==================
  Dim arr     As Variant
    Dim temp    As Variant
    Dim temp2   As Variant
    Dim cr      As Variant
    Dim cr2     As Variant
    Dim lr      As Long
    Dim i       As Long
    Dim j       As Long
    Dim c       As Long
    Dim c2      As Long
    Dim ws As Worksheet
    Dim sh As Worksheet
Dim d  As Long
d = MsgBox("هـــل تـريـد ترحيل قوائم الامتحان العملي لطلاب مجال الصناعى1 حقــاً", vbYesNo, "تحذير")
If d = vbYes Then

    Set ws = Sheets("الشيت")
    Set sh = Sheets("صناعى1")
    '= = = = = = = = = = = =
    ' الشيت الهدف المطلوبة مسح البيانات القديمة
    sh.Range("B13:I4012").ClearContents
    ' تحديد اخر صف به بيانات في الشيت المصدر
    lr = ws.Cells(Rows.Count, 7).End(xlUp).Row
    'متغير مصفوفة البيانات ومدى البيانات بها
    arr = ws.Range("A5:V" & lr).Value
    ' مصفوفة النتائج
    ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    ReDim temp2(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    'ارقام الاعمدة المطلوب نسخها
      cr = Array(6, 7)
      cr2 = Array(2)
    j = 1
    For i = LBound(arr, 1) To UBound(arr, 1)
    '==================
   ' المعيار اوالشرط ورقم عمود الترحيل
If arr(i, 10) = "صناعي1" Then
    '==================
            temp(j, 1) = j
            For c = LBound(cr) To UBound(cr)
                temp(j, c + 1) = arr(i, cr(c))
            Next c
            For c2 = LBound(cr2) To UBound(cr2)
                temp2(j, c2 + 1) = arr(i, cr2(c2))
            Next c2
            j = j + 1
    '==================
    End If
    '==================
    Next i
    With sh
    'خلية بداية اللصق في الشيت الهدف
        .Range("b13").Resize(j, UBound(temp, 2)).Value = temp
        .Range("h13").Resize(j, UBound(temp2, 2)).Value = temp2
    End With
    ' تفريغ المصفوفة
  Erase arr
  Erase temp
  Erase temp2
Else
If d = vbNo Then
End If
End If
End Sub



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

فتحياتى وتقدير واجلالى لشخصكم الكريم استاذ محمد الدسوقى وكم انتظر رد حضرتك باشتياق


تم تحرير المشاركة بواسطة :محمود ابو الدهب
بتاريخ:13-12-2017 05:20 مساء


أثارت هذه المشاركة إعجاب: ayman_2000، Yasser Elaraby، محمد الدسوقى،


توقيع :محمود ابو الدهب
لى عظيم الشرف بالانضمام لهذا الصرح العظيم
وكم أتمنى من الله
ان يعيننى ويعلمنى من علمة الواسع فهو ولي ذالك وهو على كل شي قدير

تحياتى وتقدير للجميع  محمود ابوالدهب


13-12-2017 05:38 مساء
مشاهدة مشاركة منفردة [4]
محمود ابو الدهب
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 573
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 56
يتابعهم : 6
يتابعونه : 119
قوة السمعة : 1826
الاعجاب : 664
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
كما قمت بتصميم هذا الكود لعل وعسي ان يكون ما يريد ايضا 
وارجوا ان ارى من استاذ ايمن الرد على هذا الكود ايضا

 Sub Tarheel()
Dim LR      As Long
Dim Ws      As Worksheet
Dim Sh      As Worksheet
Dim x, arr
'----------------------------------
Set Sh = Sheets("الشيت")
Set Ws = Sheets("صناعى1")
LR = Sh.Cells(Rows.Count, 7).End(xlUp).Row
'----------------------------------
Application.ScreenUpdating = False

Ws.Range("B13:I4012").ClearContents
arr = Sh.Range("a5:u" & LR + 1)

    ReDim y(1 To LR, 1 To 21)
    For x = 1 To LR - 4
        If arr(x, 10) = "صناعي1" Then
         rw = rw + 1
          y(rw, 1) = arr(x, 6)
          y(rw, 2) = arr(x, 7)
          y(rw, 7) = arr(x, 2)
        End If
     Next x

    If rw > 0 Then Ws.Cells(12, 2)(2, 1).Resize(rw, 7).Value = y()
     Erase arr
    Application.ScreenUpdating = True
End Sub


وبالنهاية تحياتى وتقديرى لكل القائمين على هذا الصرح العلمى وللجميع
 


تم تحرير المشاركة بواسطة :محمود ابو الدهب
بتاريخ:13-12-2017 05:43 مساء


أثارت هذه المشاركة إعجاب: Yasser Elaraby،


توقيع :محمود ابو الدهب
لى عظيم الشرف بالانضمام لهذا الصرح العظيم
وكم أتمنى من الله
ان يعيننى ويعلمنى من علمة الواسع فهو ولي ذالك وهو على كل شي قدير

تحياتى وتقدير للجميع  محمود ابوالدهب


13-12-2017 09:43 مساء
مشاهدة مشاركة منفردة [5]
ayman_2000
menu_open
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 04-09-2017
رقم العضوية : 337
المشاركات : 12
الجنس : ذكر
تاريخ الميلاد : 14-5-1963
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 22
الاعجاب : 6
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
المشاركة الأصلية كتبت بواسطة: محمود ابو الدهب »
عمل رائع رائع رائع استاذ محمد الدسوقي

ولكن عزرا  ولاننى  مقلد ولست مبدع مثل حضرتك فقد عدلة الكود الخاص به  كالتالى 

Sub AWAEL_1()
 '===========================
'ترحيل
 '==================
  Dim arr     As Variant
    Dim temp    As Variant
    Dim temp2   As Variant
    Dim cr      As Variant
    Dim cr2     As Variant
    Dim lr      As Long
    Dim i       As Long
    Dim j       As Long
    Dim c       As Long
    Dim c2      As Long
    Dim ws As Worksheet
    Dim sh As Worksheet
Dim d  As Long
d = MsgBox("هـــل تـريـد ترحيل قوائم الامتحان العملي لطلاب مجال الصناعى1 حقــاً", vbYesNo, "تحذير")
If d = vbYes Then

    Set ws = Sheets("الشيت")
    Set sh = Sheets("صناعى1")
    '= = = = = = = = = = = =
    ' الشيت الهدف المطلوبة مسح البيانات القديمة
    sh.Range("B13:I4012").ClearContents
    ' تحديد اخر صف به بيانات في الشيت المصدر
    lr = ws.Cells(Rows.Count, 7).End(xlUp).Row
    'متغير مصفوفة البيانات ومدى البيانات بها
    arr = ws.Range("A5:V" & lr).Value
    ' مصفوفة النتائج
    ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    ReDim temp2(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    'ارقام الاعمدة المطلوب نسخها
      cr = Array(6, 7)
      cr2 = Array(2)
    j = 1
    For i = LBound(arr, 1) To UBound(arr, 1)
    '==================
   ' المعيار اوالشرط ورقم عمود الترحيل
If arr(i, 10) = "صناعي1" Then
    '==================
            temp(j, 1) = j
            For c = LBound(cr) To UBound(cr)
                temp(j, c + 1) = arr(i, cr(c))
            Next c
            For c2 = LBound(cr2) To UBound(cr2)
                temp2(j, c2 + 1) = arr(i, cr2(c2))
            Next c2
            j = j + 1
    '==================
    End If
    '==================
    Next i
    With sh
    'خلية بداية اللصق في الشيت الهدف
        .Range("b13").Resize(j, UBound(temp, 2)).Value = temp
        .Range("h13").Resize(j, UBound(temp2, 2)).Value = temp2
    End With
    ' تفريغ المصفوفة
  Erase arr
  Erase temp
  Erase temp2
Else
If d = vbNo Then
End If
End If
End Sub



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

فتحياتى وتقدير واجلالى لشخصكم الكريم استاذ محمد الدسوقى وكم انتظر رد حضرتك باشتياق
اشكرك استاذى الفاضل محمود ابوالدهب
تقبل تحياتي

أثارت هذه المشاركة إعجاب: محمود ابو الدهب،




13-12-2017 09:55 مساء
مشاهدة مشاركة منفردة [6]
ayman_2000
menu_open
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 04-09-2017
رقم العضوية : 337
المشاركات : 12
الجنس : ذكر
تاريخ الميلاد : 14-5-1963
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 22
الاعجاب : 6
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
المشاركة الأصلية كتبت بواسطة: محمود ابو الدهب »
كما قمت بتصميم هذا الكود لعل وعسي ان يكون ما يريد ايضا 
وارجوا ان ارى من استاذ ايمن الرد على هذا الكود ايضا

 Sub Tarheel()
Dim LR      As Long
Dim Ws      As Worksheet
Dim Sh      As Worksheet
Dim x, arr
'----------------------------------
Set Sh = Sheets("الشيت")
Set Ws = Sheets("صناعى1")
LR = Sh.Cells(Rows.Count, 7).End(xlUp).Row
'----------------------------------
Application.ScreenUpdating = False

Ws.Range("B13:I4012").ClearContents
arr = Sh.Range("a5:u" & LR + 1)

    ReDim y(1 To LR, 1 To 21)
    For x = 1 To LR - 4
        If arr(x, 10) = "صناعي1" Then
         rw = rw + 1
          y(rw, 1) = arr(x, 6)
          y(rw, 2) = arr(x, 7)
          y(rw, 7) = arr(x, 2)
        End If
     Next x

    If rw > 0 Then Ws.Cells(12, 2)(2, 1).Resize(rw, 7).Value = y()
     Erase arr
    Application.ScreenUpdating = True
End Sub


وبالنهاية تحياتى وتقديرى لكل القائمين على هذا الصرح العلمى وللجميع
 
كود رائع استاذ محمود ابوالدهب لترحيل اعمدة غير متجاورة الى اعمدة غير متجاورة ، وهذا ما ردته ، اشكرك على اهتمامك
ولكن تم اضافة الاعلان عن المتغير (  Dim rw  As Long )
الكود يعمل بكفاءة اشكرك ، تقبل تحياتي

 


تم تحرير المشاركة بواسطة :ayman_2000
بتاريخ:13-12-2017 10:03 مساء


أثارت هذه المشاركة إعجاب: محمود ابو الدهب،




13-12-2017 10:06 مساء
مشاهدة مشاركة منفردة [7]
محمود ابو الدهب
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 573
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 56
يتابعهم : 6
يتابعونه : 119
قوة السمعة : 1826
الاعجاب : 664
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
تحياتى وتقديرى لشخصكم الكريم والحمد لله ان تم طلبك كما تحب 

كما انى مازلت اريد ان شاء الله من استاذ محمد الدسوقى ان يقوم بالتعديل على الكود الخاص به لارى ما الاخطاء التى وقعت فيها ونتعلم منه 
 

أثارت هذه المشاركة إعجاب: ayman_2000،


توقيع :محمود ابو الدهب
لى عظيم الشرف بالانضمام لهذا الصرح العظيم
وكم أتمنى من الله
ان يعيننى ويعلمنى من علمة الواسع فهو ولي ذالك وهو على كل شي قدير

تحياتى وتقدير للجميع  محمود ابوالدهب


14-12-2017 06:53 صباحا
مشاهدة مشاركة منفردة [8]
ayman_2000
menu_open
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 04-09-2017
رقم العضوية : 337
المشاركات : 12
الجنس : ذكر
تاريخ الميلاد : 14-5-1963
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 22
الاعجاب : 6
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
المشاركة الأصلية كتبت بواسطة: محمود ابو الدهب »
تحياتى وتقديرى لشخصكم الكريم والحمد لله ان تم طلبك كما تحب 

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





14-12-2017 05:14 مساء
مشاهدة مشاركة منفردة [9]
محمود ابو الدهب
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 573
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 56
يتابعهم : 6
يتابعونه : 119
قوة السمعة : 1826
الاعجاب : 664
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة

 [/quote]
استاذي الفاضل محمود ابو الدهب اولاً احب ان اشكر الاستاذ الفاضل محمد الدسوقى لمساهماته الجادة على تلبية طلبات الاعضاء له منا كل الشكر والتقدير والاحترام
ولكن احيط سيادتكم علماً بان استاذنا الكبير الفاضل ياسر خليل ( ابوالبراء) هو من يستطيع التعديل الكود لان الكود ترحيل اعمدة غير متجاورة الى اعمدة غير متجاورة بالمصفوفات خاص به ولكن بــدون شرط 
واضم صوتي الي صوتك واستسمح الاستاذ ابوالبراء بالتعديل على الكود بحيث يتم ترحيل اعمدة غير متجاورة الى اعمدة غير متجاورة ولكن بشرط او عدة شروط حسب الطلب لتعم الفائدة
تقبل تحيــاتي ولكم منا وافر التقدير والاحـــترام  
[/quote]

استاذ ايمن اليس التعديل الذى ارسلتة لك هو الحل كما ارد 
ولكنى لا افضل الكود المعدل او الاساسي قبل التعديل ولماذا اقولك ليه حاول تضع بيانات بعد العمود i اى بعد نطاق المسح الموضوع بالكود وضع اى بيانات بجوار الخلايا التى سيتم الترحيل اليها على ما اتذكر من الصف 13
ستلاحظ ان الكود يمسح جميع البيانات مع ان نطاق الحذف الموضوع لا يشمله لان الكود الاساسي به كسور وان شاء الله عند عودة اخى ومعلمى  استاذ ياسر سينظر في الامر
ولكن بالنسبة للكود والتعديل الذى ارده قمت بتعديلة حتى يناسب احتياجج


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

وبالنهاية بارك الله فيك ووفقق لكل الخير 

تقبل تحياتى وتقديرى 

أثارت هذه المشاركة إعجاب: ayman_2000،


توقيع :محمود ابو الدهب
لى عظيم الشرف بالانضمام لهذا الصرح العظيم
وكم أتمنى من الله
ان يعيننى ويعلمنى من علمة الواسع فهو ولي ذالك وهو على كل شي قدير

تحياتى وتقدير للجميع  محمود ابوالدهب


14-12-2017 09:42 مساء
مشاهدة مشاركة منفردة [10]
محمد الدسوقى
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 47
المشاركات : 360
الجنس : ذكر
تاريخ الميلاد : 14-10-1973
الدعوات : 40
يتابعهم : 7
يتابعونه : 228
قوة السمعة : 2379
الاعجاب : 592
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
أخى ومعلمى الأستاذ / محمود أبو الدهب
بارك الله فيك وجزيتم عنا خيرا
مجهود رائع فى الكودين سواء التعديل على الكود الأول أو الكود الثانى
خاصة الكود الثانى رائع وممتاز وبسيط للترحيل
وإن كان هناك ملاحظة صغيرة اسمح لى بإضافتها
فى السؤال كان الأستاذ ايمن يريد الترحيل بناء على الشرط الموجود فى الخلية  G9 الموجودة فى ورقة الهدف بناء على التخصصات
( صناعى 1  ـ ملابس ـ تغذية )
فلو عملنا قائمىة منسدلة بهذه الخلية ويتم الاختيار منها
وبناء عليه تعديل معيار الترحيل من :
If arr(x, 10) = "صناعى 1" Then

التعديل ليكون بالصورة
If arr(x, 10) = Ws.Range("G9").Value Then


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



 


تم تحرير المشاركة بواسطة :محمد الدسوقى
بتاريخ:14-12-2017 09:45 مساء


أثارت هذه المشاركة إعجاب: ayman_2000، محمود ابو الدهب،




14-12-2017 10:06 مساء
مشاهدة مشاركة منفردة [11]
ناصر سعيد1
menu_open
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-09-2017
رقم العضوية : 705
المشاركات : 440
الجنس : ذكر
تاريخ الميلاد : 2-2-1990
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 449
الاعجاب : 170
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
     Erase arr
    Application.ScreenUpdating = True
End Sub

جزاكم الله خيرا وبعد
المسح في المصفوفات بيتم لمصفوفه صفحه المصدر ام مصفوفه صفحه الهدف ... مجرد سؤال؟

أثارت هذه المشاركة إعجاب: ayman_2000،




14-12-2017 10:06 مساء
مشاهدة مشاركة منفردة [12]
محمود ابو الدهب
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 573
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 56
يتابعهم : 6
يتابعونه : 119
قوة السمعة : 1826
الاعجاب : 664
 offline 
look/images/icons/i1.gif المساعدة في كود ترحيل اعمدة غير متجاورة
شكرا لك استاذ محمد الدسوقى كان الله بعونك ووفقق لكل الخير 

اشكرك على التعديل فلم ادرس طلب استاذ ايمن جيدا وبارك الله فيك على هذا التعديل 

فلك منى وافر الاحترام والتقدير على ابداعاتك المستمرة والمتميزة

أثارت هذه المشاركة إعجاب: ayman_2000،


توقيع :محمود ابو الدهب
لى عظيم الشرف بالانضمام لهذا الصرح العظيم
وكم أتمنى من الله
ان يعيننى ويعلمنى من علمة الواسع فهو ولي ذالك وهو على كل شي قدير

تحياتى وتقدير للجميع  محمود ابوالدهب



المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
الترحيل من صفوف إلى اعمدة نصر الإيمان
13 209 YasserKhalil

الكلمات الدلالية
المساعدة ، ترحيل ، اعمدة ، متجاورة ،


 







اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.



الساعة الآن 10:24 مساء

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