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

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


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





الترحيل بشرط معين بالمصفوفات

الزملاء الكرام : كل عام وانتم بخير الرجا من حضراتكم المساعدة بالتعديل على كود الترحيل المرفق باليوزر فورم المرفق بالشيت ..


موضوع مغلق


28-01-2021 07:57 صباحا
ayman_2000
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 04-09-2017
رقم العضوية : 337
المشاركات : 87
الجنس : ذكر
تاريخ الميلاد : 14-5-1963
يتابعهم : 3
يتابعونه : 2
قوة السمعة : 164
 offline 

الزملاء الكرام : كل عام وانتم بخير
الرجا من حضراتكم المساعدة بالتعديل
على كود الترحيل المرفق باليوزر فورم المرفق بالشيت بحيث يتم الترحيل الى شيت الوارد_اليوم

بشرطين الشرط الاول التاريخ الشرط الثانى اسم المورد

لكم منا وافر التحية والاحترام

 
 
  كود الترحيل.rar   تحميل rar مرات التحميل :(7)
الحجم :(39.521) KB



أفضل إجابة مقدمة من ابراهيم الحداد وهي:
السلام عليكم ورحمة الله
استخدم هذا الكود
Private Sub CommandButton14_Click()
Dim Imprt As Worksheet, TodyImpt As Worksheet
Dim LR As Long, LS As Long, i As Long, j As Long, p As Long
Dim Arr As Variant, Tmp As Variant
Dim Dat As Date, Cridr As String
Set Imprt = Sheets("الوارد")
Set TodyImpt = Sheets("الوارد_اليوم")
Dat = Me.TextBox16.Value: Cridr = Me.ComboBox3.Text
LR = Imprt.Range("B" & Rows.Count).End(3).Row
LS = TodyImpt.Range("B" & Rows.Count).End(3).Row

Arr = Imprt.Range("A10:H" & LR).Value
ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 2) = Dat And Arr(i, 8) = Cridr Then
p = p + 1
For j = 1 To 8
Tmp(p, j) = Arr(i, j)
Tmp(p, 1) = p
Next
End If
Next
If p > 0 Then TodyImpt.Range("A" & LS + 1).Resize(p, UBound(Tmp, 2)).Value = Tmp


End Sub
عرض الإجابة




30-01-2021 11:29 مساء
مشاهدة مشاركة منفردة [1]
ابراهيم الحداد
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 237
الجنس : ذكر
الدعوات : 4
يتابعهم : 0
يتابعونه : 34
قوة السمعة : 2349
عدد الإجابات: 31
 offline 
look/images/icons/i1.gif الترحيل بشرط معين بالمصفوفات
السلام عليكم ورحمة الله
استخدم هذا الكود
Private Sub CommandButton14_Click()
Dim Imprt As Worksheet, TodyImpt As Worksheet
Dim LR As Long, LS As Long, i As Long, j As Long, p As Long
Dim Arr As Variant, Tmp As Variant
Dim Dat As Date, Cridr As String
Set Imprt = Sheets("الوارد")
Set TodyImpt = Sheets("الوارد_اليوم")
Dat = Me.TextBox16.Value: Cridr = Me.ComboBox3.Text
LR = Imprt.Range("B" & Rows.Count).End(3).Row
LS = TodyImpt.Range("B" & Rows.Count).End(3).Row

Arr = Imprt.Range("A10:H" & LR).Value
ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 2) = Dat And Arr(i, 8) = Cridr Then
p = p + 1
For j = 1 To 8
Tmp(p, j) = Arr(i, j)
Tmp(p, 1) = p
Next
End If
Next
If p > 0 Then TodyImpt.Range("A" & LS + 1).Resize(p, UBound(Tmp, 2)).Value = Tmp


End Sub



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


 










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

الساعة الآن 12:47 مساء