بن خليفه

فبراير 8, 2017

تفضل أخي

My Test 1.rar

أستاذ أبو عيد ..

جربت التعديل على الكود وحسب ما تعلمت من هذا المنتدى وصلت لحل وإن شاء الله يكون هو الحل الصحيح حسب الكود التالي :

Sub Macro1()

Dim a, b, c, d

a = Sheets(1).Range("B3", "E3").Row

b = Sheets(2).Range("B20000").End(xlUp).Row + 1

c = Sheets(2).Range("H20000").End(xlUp).Row + 1

For d = 3 To a

Sheets(2).Range("B" & b).Resize(1, 3) = Sheets(1).Range("B" & d).Resize(1, 3).Value

Sheets(2).Range("H" & c).Resize(1, 2) = Sheets(1).Range("E" & d).Resize(1, 2).Value

b = b + 1

c = c + 1

Next

MsgBox "تمت العملية بنجاح", vbOKOnly, "انتهاء عملية الترحيل"

End Sub

فبراير 8, 2017

تفضل أخي

My Test 1.rar

لك كل الشكر أستاذ أبو عيد

لكن إللي أحتاجه كيف يتم ترحيل اللي في الصف من B3 إلى E3 في الشيت الأول فقط .. اللي في الشيت الثاني هو المطلوب إنه يترحل لشكل جدول

الشيت الأول أحتاج يكون المدخل من صف واحد يعني حتى لو كان جدول ما احتاج يترحل منه إلا اللي في الصف فقط

وشكراً

فبراير 7, 2017

استفسار واعتقد انه بسيط

في حال أردت أن يكون الرقم الظاهر عند الضغط على الزر وكتابة الرقم السري على شكل نجوم للحماية هل يوجد تعديل على الكود ؟؟

فبراير 7, 2017

الاخوة الكرام ..

يرجى منكم المساعدة في الملف المرفق ..

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

وشكراً

My Test HSK 2017.rar

يونيو 19, 2016

الله يعطيك العافية يا غالي ، وجدت الخطأ

المفترض B59 وليس B69

لأني مسوي اخفاء

أنا اسف لأني تعبتك معي

يونيو 19, 2016

متأكد

مع العلم تم تحويل الكود الأول ونجح والثاني برضه يعطيني خطأ ؟؟؟؟!!!!!!

مرفق الملف

Dukka Phone.rar

يونيو 19, 2016

الخطأ صار في السطر الثاني

Sub Maint_click()

Sheets("Maint").Range("B5:H16").Copy

Sheets("Report").Range("B69").PasteSpecial (xlPasteValues)

End Sub

يونيو 19, 2016

أشكرك يا أستاذي يا غالي على الرد والتوجيه

يونيو 19, 2016

المودل الأول يعمل والثاني لا يعمل

الأول يقوم بنسخ من الشيت3 إلى الأول حسب الرينج

الثاني يعطيني خطأ وهو يقوم بالنسخ من الشيت 2 إلى 3

الخطأ في اللون الأحمر !!!!

Sub taj_click()
Sheets("Taj").Select
     Range("B5:H53").Select
     Selection.Copy
     Sheets("Report").Select
     Range("B8").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False

    End Sub

Sub Maint_click()
Sheets("Maint").Select
     Range("B5:H16").Select
     Selection.Copy
     Sheets("Report").Select
     Range("B69").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False

End Sub

يونيو 17, 2016

مشكوووووور ودعواتي لك يا غالي

هل يوجد لها شرح يا عسل ؟

يونيو 17, 2016

لاخوة الكرام والله إني منقطع لكن احتجت إني أرجع للاكسل ونسيت أشياء مهمة

في المرفق جدول أحتاج دالة تجمع أرقام مبالغ لمدخل معين في المرفق أحتاج المطلوب في C10 و D10

دالة تجميع.rar

يونيو 17, 2016

الاخوة الكرام والله إني منقطع لكن احتجت إني أرجع للاكسل ونسيت أشياء مهمة

في المرفق جدول أحتاج دالة تجمع أرقام مبالغ لمدخل معين في المرفق أحتاج المطلوب في C10 و D10

دالة تجميع.rar

يونيو 17, 2016

ما شاء الله تبارك الله ، الله يوفقك يا أستاذنا

غبت فترة ورجعت - وللإبداع بقية

أبريل 17, 2016

في 4/15/2016 at 20:35, ياسر العربى said:

تفضل شوف المرفق دا

Match.rar

عزيزي وأستاذي ياسر ..

أنا أبغا كود بدون ما أظهره في اليوزر فورم

يعني أحدد الداتا من شيت 3 مثلا وأحدد الرينج

أبريل 15, 2016

في 4/12/2016 at 12:08, ياسر العربى said:

تفضل اخي الكريم لعله المطلوب اختر البحث بمعلومية الB or C

وين أحط اسم الشيت في كود اليوزرفورم إذا كنت أستخدم أكثر من شيت

Match.rar

أبريل 15, 2016

UP

أبريل 13, 2016

22 ساعات مضت, ياسر العربى said:

تفضل اخي الكريم لعله المطلوب اختر البحث بمعلومية الB or C

Match.rar

أشكرك يا عسل

ومنكم نتعلم

أبريل 13, 2016

في 4/11/2016 at 18:08, الجموعي said:

أرفع لي الملف الذي قمت بالتعديل عليه الذي بهكود الخاص بإظهار اليوزر واخفاء ملف الاكسل

أستاذي الفاضل / الجموعي

المرفق هو المشروع الذي أعمل عليه

عيرت طريقة الكومبوبوكس

شوف Page 5 , Page 4 , Page 3

يظهر لي خطأ - الصور في المرفق

The New SSC 7.rar

أبريل 11, 2016

45 دقائق مضت, ابوعبدالواجد said:

السلام عليكم

الاستاذ الجموعي حياك الله

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

فهرست العملاء.rar

منتظر الجموعي لأني ماشي معاه من بداية المشروع وأكيد تجي وشوفhttp://www.officena.net/ib/applications/core/interface/file/attachment.php?id=110560 المرفق

أبريل 11, 2016

ماشاء الله تبارك الله

الله يعطيك ألف عافيه

أبريل 11, 2016

في 4/4/2016 at 14:38, الجموعي said:

معذرة عن التأخير في الرد بسبب المشاغل

تفضل لعله المطلوب

بحث معدل1.rar

أستاذ / الجموعي ..

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

الكود :

Private Sub UserForm_Activate()

Dim t As Integer

Dim R As Variant

For t = 3 To 4

R = Sheets(t).Name هنا يظهر الخطأ

Me.ComboBox1.AddItem R

Private Sub ComboBox1_Change()

If Me.ComboBox1.Value = "" Then: Exit Sub

End Sub

Private Sub ListSearch_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Me.TextBox1.Value = ListSearch.List(ListSearch.ListIndex, 0)

Me.TextBox2.Value = ListSearch.List(ListSearch.ListIndex, 1)

Me.TextBox3.Value = ListSearch.List(ListSearch.ListIndex, 2)

Me.TextBox18.Value = ListSearch.List(ListSearch.ListIndex, 3)

Me.TextBox19.Value = ListSearch.List(ListSearch.ListIndex, 4)

End Sub

Private Sub ButtonSearch_Click()

On Error Resume Next

Dim ws As Worksheet

Dim V As Integer

Dim LastRow As Integer

Dim M As String

Dim Q, F

ListSearch.Clear

If TextSearch.Text = "" Then GoTo 1

M = TextSearch.Text

Set ws = Sheets(ComboBox1.Value)

With ws

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

Set Q = .Range("B2:B" & LastRow).Find(M)

If Not Q Is Nothing Then

F = Q.Address

Do

If Application.WorksheetFunction.Search(M, Q, 0) = 1 Then

ListSearch.AddItem Q.Value

ListSearch.List(V, 1) = Q.Offset(0, 1).Value

ListSearch.List(V, 2) = Q.Offset(0, 2).Value

ListSearch.List(V, 3) = Q.Offset(0, 3).Value

ListSearch.List(V, 4) = Q.Offset(0, 4).Value

ListSearch.List(V, 5) = Q.Offset(0, 5).Value

V = V + 1

End If

Set Q = .Range("B2:B" & LastRow).FindNext(Q)

Loop While Not Q Is Nothing And Q.Address <> F

End If

End With

1 End Sub

أبريل 8, 2016

48 دقائق مضت, سليم حاصبيا said:

ضع الكود بهذا الشكل


Sub My_formula()
For i = 1 To Sheets.Count
Sheets(i).Range("e3").FormulaR1C1 = "=IFERROR(IF(ISERROR(MATCH(R2C5,C3,0)),INDEX(C3,MATCH(""*""&R2C5&""*"",C2,0)),INDEX(C2,MATCH(R2C5,C3,0))),"" "")"
Next
End Sub

أشكرك لكن مو هذا اللي أقصده ..

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

أبريل 8, 2016

38 دقائق مضت, سليم حاصبيا said:
الكود المطلوب
Sub My_formula()
Range("e3").FormulaR1C1 = "=IFERROR(IF(ISERROR(MATCH(R2C5,C3,0)),INDEX(C3,MATCH(""*""&R2C5&""*"",C2,0)),INDEX(C2,MATCH(R2C5,C3,0))),"" "")"
End Sub

العمل لدي في أكثر من شيت .. على أكثر من عمل في اليوزر ..

أنا هنا كيف أحدد الشيت ؟؟

أبريل 8, 2016

المطلوب كود VBA يقوم بعمل الدالة
IFERROR(IF(ISERROR(MATCH($E$2,$C:$C,0)),INDEX($C:$C,MATCH("*"&$E$2&"*",$B:$B,0)),INDEX($B:$B,MATCH($E$2,$C:$C,0)))," ")

المدخل في الخلية E5 من العمود B ما يقابله العمود C والعكس مع العلم أنه يمكن كتابة جزء من العمود B يعطي الناتج الصحيح في العمود C
ويمكن كتابته حروف كبيرة أو صغيرة

Match.rar

أبريل 4, 2016

4 ساعات مضت, الجموعي said:

معذرة عن التأخير في الرد بسبب المشاغل

تفضل لعله المطلوب

بحث معدل1.rar

والله أشكرك يا غالي وهو المطلوب ..

الله يسعد أيامك كلها

تسجيل الدخول

المنتدى

مكتبة الموقع

معرض الصور

المدونات

الوسائط المتعددة

مشاركات المكتوبه بواسطه بن خليفه

Important Information