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

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
محمدعبدالسلام لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة طلب مساعدة اريد في كل 4 من شهر يتم نسح الاسم من عمود الى عمود اكسيل اسئله واجابات


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





مطلوب كود ترحيل الصنف من خلال فورم بحث

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


موضوع مغلق


28-10-2020 07:45 مساء
حبيبتى دائما
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 19-07-2019
رقم العضوية : 13887
المشاركات : 93
الجنس : ذكر
تاريخ الميلاد : 5-3-1984
يتابعهم : 9
يتابعونه : 0
قوة السمعة : 76
 offline 

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

 
 
 
  ترحيل.xlsm   تحميل xlsm مرات التحميل :(14)
الحجم :(2546.484) KB



أفضل إجابة مقدمة من hassona229 وهي:
                                                                وعليكم السلام ورحمه الله وبركاته
                                                              تفضل الكود كاملا البحث والترحيل

Option Explicit

Private WS As Worksheet, SH As Worksheet

Private Sub Label2_Click()

End Sub

Private Sub UserForm_Initialize()
Set WS = ThisWorkbook.Worksheets("المخزن")
Set SH = ThisWorkbook.Worksheets("مبيعات")
End Sub
Private Sub TextFind_Change()
Dim K As Integer, C As Range, LR As Long
'( 3  )معرفة اخر سطر به بيانات في العامود الذي نريد البحث فيه وهو هنا الصنف
LR = WS.Cells(Rows.Count, 3).End(xlUp).Row
    K = 0
'         تجاهل اي خطأ ثم يكمل مشوار الالف خطوة
          On Error Resume Next
'    بدء التعامل مع الليست بوكس
    With Me.ListFind
'    مسح محتويات الليست بوكس قبل تعبئة الليست بوكس
        .Clear
'        عدد الاعمدة في الليست بوكس
        .ColumnCount = 1
    '        (C)البحث عن طريق العامود
        For Each C In WS.Range("C2:C" & LR)
    '          البحث باى حرف من حروف الكلمة سواء اول الكلمه او اخرها او منتصفها
          If C Like "*" & TextFind.Value & "*" Then
'          بدء تعبئة الليست بوكس
              .AddItem
    '              .List(K, 0) الصفر هنا هو اول عامود في الليست
              .List(K, 0) = WS.Cells(C.Row, 3).Value
     '         .List(K, 1) الواحد هنا هو عامود العدد هو ثانى عامود في الليست
              .List(K, 1) = WS.Cells(C.Row, 4).Value
    '          .List(K, 2) الاثنين هنا هو عامود السعر هو ثالث عامود في الليست
              .List(K, 2) = WS.Cells(C.Row, 5).Value
    K = K + 1
          End If
        Next C
    End With
End Sub
Private Sub Listfind_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim SHLR As Long, I As Long
    For I = 0 To Me.ListFind.ListCount
        If Me.ListFind.Selected(I) = True Then
'          مفعل  كمل OptionButton3   لو كان
            If OptionButton3.Value = True Then
            '( 6  )معرفة اخر سطر به بيانات في العامود الذي نريد الترحيل اليه في المبيعات وهو هنا
                SHLR = SH.Cells(Rows.Count, 6).End(xlUp).Row + 1
                SH.Range("F" & SHLR).Value = Me.ListFind.List(I, 0)
                SH.Range("G" & SHLR).Value = Me.ListFind.List(I, 1)
                SH.Range("H" & SHLR).Value = Me.ListFind.List(I, 2)
                '                    معادله لحساب العدد في السعر بدل كتابتها في كل العامود
                SH.Range("I" & SHLR).Formula = "=" & SH.Range("G" & SHLR).Address & "*" & SH.Range("H" & SHLR).Address
                 CreateObject("WScript.Shell").Popup "نم ترحيل البيانات بنجاح", 1, "صل على النبي"
            Else
            '          مفعل  كمل OptionButton4   لو كان
                If OptionButton4.Value = True Then
 '                  ( 12  )معرفة اخر سطر به بيانات في العامود الذي نريد الترحيل اليه في المشتريات وهو هنا
                    SHLR = SH.Cells(Rows.Count, 12).End(xlUp).Row + 1
                    SH.Range("L" & SHLR).Value = Me.ListFind.List(I, 0)
                    SH.Range("M" & SHLR).Value = Me.ListFind.List(I, 1)
                    SH.Range("N" & SHLR).Value = Me.ListFind.List(I, 2)
'                    معادله لحساب العدد في السعر بدل كتابتها في كل العامود
                    SH.Range("O" & SHLR).Formula = "=" & SH.Range("M" & SHLR).Address & "*" & SH.Range("N" & SHLR).Address
                    CreateObject("WScript.Shell").Popup "نم ترحيل البيانات بنجاح", 1, "صل على النبي"
                End If
            End If
        Else
        End If
    Next I
End Sub

 
عرض الإجابة




30-10-2020 12:37 صباحا
مشاهدة مشاركة منفردة [1]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 808
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 11
قوة السمعة : 4330
عدد الإجابات: 113
 offline 
look/images/icons/i1.gif مطلوب كود ترحيل الصنف من خلال فورم بحث
                                                                وعليكم السلام ورحمه الله وبركاته
                                                              تفضل الكود كاملا البحث والترحيل

Option Explicit

Private WS As Worksheet, SH As Worksheet

Private Sub Label2_Click()

End Sub

Private Sub UserForm_Initialize()
Set WS = ThisWorkbook.Worksheets("المخزن")
Set SH = ThisWorkbook.Worksheets("مبيعات")
End Sub
Private Sub TextFind_Change()
Dim K As Integer, C As Range, LR As Long
'( 3  )معرفة اخر سطر به بيانات في العامود الذي نريد البحث فيه وهو هنا الصنف
LR = WS.Cells(Rows.Count, 3).End(xlUp).Row
    K = 0
'         تجاهل اي خطأ ثم يكمل مشوار الالف خطوة
          On Error Resume Next
'    بدء التعامل مع الليست بوكس
    With Me.ListFind
'    مسح محتويات الليست بوكس قبل تعبئة الليست بوكس
        .Clear
'        عدد الاعمدة في الليست بوكس
        .ColumnCount = 1
    '        (C)البحث عن طريق العامود
        For Each C In WS.Range("C2:C" & LR)
    '          البحث باى حرف من حروف الكلمة سواء اول الكلمه او اخرها او منتصفها
          If C Like "*" & TextFind.Value & "*" Then
'          بدء تعبئة الليست بوكس
              .AddItem
    '              .List(K, 0) الصفر هنا هو اول عامود في الليست
              .List(K, 0) = WS.Cells(C.Row, 3).Value
     '         .List(K, 1) الواحد هنا هو عامود العدد هو ثانى عامود في الليست
              .List(K, 1) = WS.Cells(C.Row, 4).Value
    '          .List(K, 2) الاثنين هنا هو عامود السعر هو ثالث عامود في الليست
              .List(K, 2) = WS.Cells(C.Row, 5).Value
    K = K + 1
          End If
        Next C
    End With
End Sub
Private Sub Listfind_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim SHLR As Long, I As Long
    For I = 0 To Me.ListFind.ListCount
        If Me.ListFind.Selected(I) = True Then
'          مفعل  كمل OptionButton3   لو كان
            If OptionButton3.Value = True Then
            '( 6  )معرفة اخر سطر به بيانات في العامود الذي نريد الترحيل اليه في المبيعات وهو هنا
                SHLR = SH.Cells(Rows.Count, 6).End(xlUp).Row + 1
                SH.Range("F" & SHLR).Value = Me.ListFind.List(I, 0)
                SH.Range("G" & SHLR).Value = Me.ListFind.List(I, 1)
                SH.Range("H" & SHLR).Value = Me.ListFind.List(I, 2)
                '                    معادله لحساب العدد في السعر بدل كتابتها في كل العامود
                SH.Range("I" & SHLR).Formula = "=" & SH.Range("G" & SHLR).Address & "*" & SH.Range("H" & SHLR).Address
                 CreateObject("WScript.Shell").Popup "نم ترحيل البيانات بنجاح", 1, "صل على النبي"
            Else
            '          مفعل  كمل OptionButton4   لو كان
                If OptionButton4.Value = True Then
 '                  ( 12  )معرفة اخر سطر به بيانات في العامود الذي نريد الترحيل اليه في المشتريات وهو هنا
                    SHLR = SH.Cells(Rows.Count, 12).End(xlUp).Row + 1
                    SH.Range("L" & SHLR).Value = Me.ListFind.List(I, 0)
                    SH.Range("M" & SHLR).Value = Me.ListFind.List(I, 1)
                    SH.Range("N" & SHLR).Value = Me.ListFind.List(I, 2)
'                    معادله لحساب العدد في السعر بدل كتابتها في كل العامود
                    SH.Range("O" & SHLR).Formula = "=" & SH.Range("M" & SHLR).Address & "*" & SH.Range("N" & SHLR).Address
                    CreateObject("WScript.Shell").Popup "نم ترحيل البيانات بنجاح", 1, "صل على النبي"
                End If
            End If
        Else
        End If
    Next I
End Sub

 

30-10-2020 05:16 مساء
مشاهدة مشاركة منفردة [2]
حبيبتى دائما
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 19-07-2019
رقم العضوية : 13887
المشاركات : 93
الجنس : ذكر
تاريخ الميلاد : 5-3-1984
يتابعهم : 9
يتابعونه : 0
قوة السمعة : 76
 offline 
look/images/icons/i1.gif مطلوب كود ترحيل الصنف من خلال فورم بحث
شكر خاص لاخى حسونة 
وشكر للاستاذ ياسر خليل 
بارك الله فيكم
وجزاكم الله عنا كل خير وجعله الله فى ميزان حسناتكم 
وللقائمين على المنتدى لكم منى كل احترام وتقدير

30-10-2020 06:30 مساء
مشاهدة مشاركة منفردة [3]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 808
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 11
قوة السمعة : 4330
عدد الإجابات: 113
 offline 
look/images/icons/i1.gif مطلوب كود ترحيل الصنف من خلال فورم بحث
الحمد لله الذي بنعمته تتم الصالحات 
وجزاكم مثله 



الكلمات الدلالية
فورم ، الصنف ، خلال ، ترحيل ، مطلوب ،


 










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

الساعة الآن 06:22 مساء