logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
EM_ACC ali mohamed ali-- لا تميز خلال هذه الفترة YasserKhalil لا تميز خلال هذه الفترة اكسيل اسئله واجابات



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




موضوع مغلق


  • تمت الإجابة
28-10-2020 07:45 مساءً
السلام عليكم ورحمة الله وبركاتة
الشكر وكل الشكر للقائمين على هذا المنتدى العظيم
فى الملف المرفق جهد عظيم لاخى وحبيبى حسونة وهو فورم بحث بمدلول كتابة اى حرف
واريد من الاخوة الافاضل
عندما ابحث واقوم باختيار النتيجة عن طريق الضغط مرتين يتم ترحيل الصنف بحسب الوجهه المبينة فى الفورم
يتم الترحيل الى شيت المبيعات عند اختيار كلمة مشتريات او مبيعات
لو مبيعات يتم الترحيل الى العمود F
ولو مشتريات يتم الترحيل الى العمود L
وتظهر رسالة بعد الضغط بتم الترحيل وتحتفى حالا
 
 
  ترحيل.xlsm   تحميل xlsm مرات التحميل :(13)
الحجم :(2546.484) KB


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



look/images/icons/i1.gif مطلوب كود ترحيل الصنف من خلال فورم بحث
  30-10-2020 12:37 صباحاً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 794
الدولة : مصر
الجنس :
تاريخ الميلاد : 13-9-1980
قوة السمعة : 3874
الاعجاب : 7
وعليكم السلام ورحمه الله وبركاته
تفضل الكود كاملا البحث والترحيل
CODE

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

أثارت هذه المشاركة إعجاب: YasserKhalil، حبيبتى دائما، noureddine70،



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

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



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

أثارت هذه المشاركة إعجاب: YasserKhalil، رمضان بكري،





المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
ترحيل بيانات من خلايا مختلفه من ملفات الى ملف واحد مع كتابة الملاحظات التى تخص ترحيل البيانات Lotfy
7 167 YasserKhalil
فورم ترحيل ايات القران الكريم من التكست بوكس الى خلية الاكسل باى عدد من الكلمات مجدى يونس
2 77 مجدى يونس
ترحيل كل بيانات الموظفين الى شيتات مستقلة Redha
1 176 Redha
طلب اضافة كود ترحيل ahmed89
0 121 ahmed89
تعديل كود الفلترة و الترحيل ayoub2007
0 170 ayoub2007

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









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

الساعة الآن 08:49 AM