ترحيل تلقائي

[مسلـم]

السلام عليكم 

لو سمحتوا إخواني الكرام ,,,

إذا في إمكانية عند الضغط على خلية " الرصيد H1 " وكتابة رقم "4" مثلاَ ، يتم ترحيل الرصيد الجديد "I1" إلي صفحة " الأرصدة " عند رقم "4 خلية B7"

ارسلت مرفق لتوضيح الأمر ، كلمة المرور 1122

شاكر لكم حسن تعاونكم

new.xlsm

[حسونة حسين]

وعليكم السلام ورحمة الله وبركاته 

جرب هذا التعديل

Private Sub TextBox2_Change()
    If TextBox2 = "" Then
        AutoFilterMode = False
    Else
        Range("H1").AutoFilter , field:=8, Criteria1:=TextBox2.Text    'Right(TextBox2.Text, Len(TextBox2.Text)) & "*"
        Dim X
        X = Application.Match(Val(TextBox2), ورقة3.Columns(4), 0)
        If Not IsError(X) Then ورقة3.Cells(X, "B").Value = ورقة1.Cells(1, "I").Value
    End If
End Sub

 

[مسلـم]

23 ساعات مضت, حسونة حسين said:

جرب هذا التعديل

Private Sub TextBox2_Change()
    If TextBox2 = "" Then
        AutoFilterMode = False
    Else
        Range("H1").AutoFilter , field:=8, Criteria1:=TextBox2.Text    'Right(TextBox2.Text, Len(TextBox2.Text)) & "*"
        Dim X
        X = Application.Match(Val(TextBox2), ورقة3.Columns(4), 0)
        If Not IsError(X) Then ورقة3.Cells(X, "B").Value = ورقة1.Cells(1, "I").Value
    End If
End Sub

 

أخي الأستاذ / حسونة حسين 

أولا : جزاك الله خيراً على حُسن تعاونك واهتمامك

ثانياّ : حضرتك ممكن تعدل فيها بحيث إن الخلية تكون بلون آخر بورقة "الأرصدة" .

** ولو في شيت آخر حابب الأرصدة تنتقل إليه  إزاي حضرتك اعملها ** .

وشاكر لك جهدك الطيب ..

تم تعديل مارس 21, 2023 بواسطه so00os
تعديل بالكتابة

[حسونة حسين]

وجزاكم مثله اخي

جرب هذا التعديل

Private Sub TextBox2_Change()
    If TextBox2 = "" Then
        AutoFilterMode = False
    Else
        Range("H1").AutoFilter , field:=8, Criteria1:=TextBox2.Text    'Right(TextBox2.Text, Len(TextBox2.Text)) & "*"
        Dim X
        X = Application.Match(Val(TextBox2), ورقة3.Columns(4), 0)
        If Not IsError(X) Then
            With ورقة3.Cells(X, "B")
                .Value = ورقة1.Cells(1, "I").Value
                .Interior.ColorIndex = 30    'From 1 to 56 لون الخلفيه
                .Font.ColorIndex = 20     'From 1 to 56 لون الخط
            End With
        End If
    End If
End Sub

 

[مسلـم]

 الكود شغال ممتاز ما شاء الله 

جزاك الله خيراً ،، 

[حسونة حسين]

وجزاكم مثله اخى

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

 

[مسلـم]

السلام عليكم

لو سمحت عند البحث بخلية ( الرصيد ) وكتابة مثلاَ ( 123 ) يظهر معي أيضاَ بصفحة ( الأرصدة ) رقم ( 1 ، 12 ، 123 ) مع اني بحثت على رقم (123) فقط 

هل المعادلة تحتاج إلى تعديل ؟

أرسلت مرفق لتوضيح الأمر ، كلمة المرور 1122

شاكر لكم حسن تعاونكم

MD.xlsm

[حسونة حسين]

السلام عليكم

جرب هذا التعديل

Private Sub TextBox2_Change()
    If TextBox2 = "" Then
        AutoFilterMode = False
    Else
        Ans = MsgBox("هل انتهيت من الكتابه", vbYesNo)
        If Ans = vbYes Then
            Range("H1").AutoFilter , field:=8, Criteria1:=TextBox2.Text
            Dim X
            X = Application.Match(Val(TextBox2), ورقة3.Columns(4), 0)
            If Not IsError(X) Then
                With ورقة3.Cells(X, "B")
                    .Value = ورقة1.Cells(1, "I").Value
                    .Interior.ColorIndex = 30    'From 1 to 56 لون الخلفيه
                    .Font.ColorIndex = 20     'From 1 to 56 لون الخط
                End With
            End If
        End If
    End If
End Sub

 

[مسلـم]

وعليكم السلام ورحمه الله وبركاته

بارك الله فيك أستاذ حسونة حسين

الكود شغال ممتاز لكن للأسف راح يكون مرهق 

كنت أريد من حضرتك لو تعدل الكود بحيث لا تظهر رسالة ( هل انتهيت من الكتابة )

لان مع زيادة العمل راح يكون شاق جدا

ولك مني فائق الاحترام والتقدير

 

[حسونة حسين]

تفضل اخي جرب هذا التعديل

اخي الكود يقوم بالاتي

١ - يبحث عن ما تكتبه قي التيكست بوكس

٢ - يضيفه في الليست بوكس

٣ - الضغط مرتين على البيان الذي تريده في الليست بوكس ضغطتين متتالتين

٤ - عندها يقوم بعمل فلتر للبيان في الشيت

٥- يقوم بترحيل البيان الى ورقه الارصده 

٦ - يقوم بمسح الرقم من التيكست بوكس 

٧- عندما يتم مسح الرقم من التيكست بوكس يتم ازاله الفلتر

 

 

 

MD_24-04-2024.xlsm

[مسلـم]

الله يعطيك العافية أخي الكريم الأستاذ @حسونة حسين 

الله يجزاك خير وجعله الله في ميزان حسانتك

[مسلـم]

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

[حسونة حسين]

لا يوجد قائمه منسدله

انما ليست بوكس

يتم التحكم بها من الكود

Listbox1.left = 8000

Listbox1.top = 5

ممكن تعدلهم كيفما شئت

[مسلـم]

تسلم ما قصرت وشكرا لحضرتك

[حسونة حسين]

تفضل اخى

الكود بطريقه ثانيه لعلها تكون المطلوبه

Private Sub TextBox2_Change()
    Application.OnTime Now() + TimeValue("00:00:02"), "ورقة1.test"
End Sub

Sub test()
    If TextBox2 = "" Then
        AutoFilterMode = False
    Else
        Range("H1").AutoFilter , field:=8, Criteria1:=TextBox2.Text
        Dim X
        X = Application.Match(Val(TextBox2), ورقة3.Columns(4), 0)
        If Not IsError(X) Then
            With ورقة3.Cells(X, "B")
                .Value = ورقة1.Cells(1, "I").Value
                .Interior.ColorIndex = 30
                .Font.ColorIndex = 20
            End With
        End If
    End If
End Sub

 

[مسلـم]

الله يبارك في حضرتك ، جزاك الله خيرا أخي @حسونة حسين

ما شاء الله الكود شغال ممتاز 😍