مساعدة فى تعديل معادلة

[a.kawkab]

فى شيت مجانى مطلوب تعديل المعادلة بالعمود z بحيث

تجلب اسم الصنف من العمودF

بدلا من كتابة الحرف d

ليكون الناتج مثل العمودAB

جوجل ميل فرع سوهاج 10-2019.xlsx

[سليم حاصبيا]

استبدل الى هذه المعادلة

=CHOOSE(($U2<$Y2)+($Y2="")+1,"",F2)

 

[a.kawkab]

شكرا استاذنا الفاضل ا/ سليم 

ممكن طلب اخر لو تكرمت 

مطلوب كود او معادلة ايهما ايسر لفلترة الاصناف الناتجة من معادلةchoose فى العمود z ,وترحيلها الى صفحة جديدة

[سليم حاصبيا]

جرب هذا الكود

النتيجة في شيت SALIM

Option Explicit

Sub FILL_DATA()
Dim R#, i#, m#: m = 2
Dim Maj As Worksheet, Sal As Worksheet

Set Maj = Sheets("مجاني")
Set Sal = Sheets("SALIM")
Sal.Range("A2", Range("A1").End(4)).ClearContents
R = Maj.Cells(Rows.Count, "Z").End(3).Row

For i = 2 To R
 If Maj.Cells(i, "Z") <> vbNullString Then
  Sal.Cells(m, 1) = Maj.Cells(i, "Z")
  m = m + 1
  End If
Next
End Sub

الملف مرفق

My_book.xlsm

[a.kawkab]

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

My_book.xlsm

[سليم حاصبيا]

تم التعديل على الماكرو كما تريد

 

My_book (1).xlsm

[a.kawkab]

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

#Dim R#, i#, m

R = Maj.Cells(Rows.Count, "Z").End(3).Row

 

Sal.Range("A2", Range("A1").End(4)).ClearContents

مامعنى # فى السطر الاول 

ومعتى( end(3 قى السطر الثانى وشكرا (هل تعنى( end(xl up

ومعنى (end(4 فى السطر الثالث وشكرا لكم

تم تعديل نوفمبر 7, 2019 بواسطه a.kawkab

[a.kawkab]

استاذنا الفاضل ا/ سليم شكرا لمجهودك واود الا ان اكون اثقلت على حضرتك لقد تم المطلوب بفضل مجهودكم ولكن طلب منى فى العمل ان يكون ترحيل البيانات مصحوبا بالمعادلات الموجودة فى شيت مجانى وليس ترحيل قيم فقط فهل اطمع فى كرم حضرتكم ان تعدل الكود بحيث يتم ترحيل البيانات من شيت مجانى الى شيت salim مصحوبا بالمعادلات وليس قيم فقط وشكرا لسعة صدركم

[سليم حاصبيا]

لا افهم ما الغاية من هذا الشيء

لأن الصفحة الثّانية بعد نسخ المعادلات تصبح نسخة طبق الاصل عن الصفحة  "بيان"

على كل حال اليك هذا الكود للنسخ مع المعادلات

Option Explicit

Sub FILL_DATA_WITH_FORMULAS()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Dim R#, i#, m#: m = 3
Dim Maj As Worksheet, Sal As Worksheet

Set Maj = Sheets("مجاني")
Set Sal = Sheets("SALIM")
Sal.Range("A2").CurrentRegion.Offset(1).Clear
R = Maj.Cells(Rows.Count, "Z").End(3).Row

For i = 2 To R
 If Maj.Cells(i, "Z") <> vbNullString Then
 Maj.Cells(i, 1).Resize(, 26).Copy
 Sal.Cells(m, 1).PasteSpecial (11)

  m = m + 1
  End If
Next
'Sal.Columns.AutoFit
Sal.Range("A3").CurrentRegion.Borders.LineStyle = 1
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

 

[a.kawkab]

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