اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

احمدزمان

أوفيسنا
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    4,385

  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    12

 نوع المحتوي 

مشاركات المكتوبه بواسطه احمدزمان

    مطلوب كود ترحيل بيانات

    في منتدى الاكسيل Excel

    قام بنشر

    منذ ساعه, yasser_w_2010 said:

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

    طلب اخير هل يمكن كود لحذف بعد الترحيل

    والف شكر لمجهود حضرتك

    العفو

    تم اضافة المسح للخلايا المرحلة

    منذ ساعه, yasser_w_2010 said:

    اسف لحضرتك ولاكن عندالترحيل لا يرحل اسفل كل خليه فارغه اوقات بيرحل في نفس الصف واوقات بيرحل تحته وبيسيب صف فاضي

    تم التعديل

    المصنف1.xlsm

    • Like 1

    مطلوب كود ترحيل بيانات

    في منتدى الاكسيل Excel

    قام بنشر

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

    Dim FS As Worksheet, TS As Worksheet
Dim TR, FR, FC, TC
Set FS = Sheets("order2")
Set TS = Sheets("save")
TR = Application.CountA(TS.Range("A:A")) + 3
With TS
3
If Cells(TR, 1) <> "" Then
TR = TR + 1
GoTo 3
End If
.Cells(TR, 1) = FS.Cells(4, 4)
.Cells(TR, 2) = FS.Cells(4, 7)
.Cells(TR, 3) = FS.Cells(5, 4)
.Cells(TR, 4) = FS.Cells(6, 4)
.Cells(TR, 5) = FS.Cells(4, 11)
.Cells(TR, 6) = FS.Cells(5, 11)
.Cells(TR, 7) = FS.Cells(7, 4)
.Cells(TR, 8) = FS.Cells(6, 11)
.Cells(TR, 9) = FS.Cells(7, 11)
.Cells(TR, 10) = FS.Cells(8, 4)
.Cells(TR, 11) = FS.Cells(8, 6)
.Cells(TR, 12) = FS.Cells(8, 8)
.Cells(TR, 13) = FS.Cells(8, 10)
.Cells(TR, 14) = FS.Cells(8, 12)
TC = 17
For FR = 10 To 19
For FC = 2 To 11
.Cells(TR, TC) = FS.Cells(FR, FC)
TC = TC + 1
Next 'FC
Next 'FR
End With

    تفضل

     

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

    Dim FS As Worksheet, TS As Worksheet
Dim TR, FR, FC, TC
Set FS = Sheets("order2")
Set TS = Sheets("save")
TR = Application.CountA(TS.Range("A:A")) + 3
With TS
3
If Cells(TR, 1) <> "" Then
TR = TR + 1
GoTo 3
End If
.Cells(TR, 1) = FS.Cells(4, 4)
.Cells(TR, 2) = FS.Cells(4, 7)
.Cells(TR, 3) = FS.Cells(5, 4)
.Cells(TR, 4) = FS.Cells(6, 4)
.Cells(TR, 5) = FS.Cells(4, 11)
.Cells(TR, 6) = FS.Cells(5, 11)
.Cells(TR, 7) = FS.Cells(7, 4)
.Cells(TR, 8) = FS.Cells(6, 11)
.Cells(TR, 9) = FS.Cells(7, 11)
.Cells(TR, 10) = FS.Cells(8, 4)
.Cells(TR, 11) = FS.Cells(8, 6)
.Cells(TR, 12) = FS.Cells(8, 8)
.Cells(TR, 13) = FS.Cells(8, 10)
.Cells(TR, 14) = FS.Cells(8, 12)
TC = 17
For FR = 10 To 19
For FC = 2 To 11
.Cells(TR, TC) = FS.Cells(FR, FC)
TC = TC + 1
Next 'FC
Next 'FR
End With

    تفضل

     

    المصنف1.xlsm

    • Like 1

    ترتيب جدول بحسب التاريخ الهجري

    في منتدى الاكسيل Excel

    قام بنشر

    الله يكرمك و يوسع عليك

    تم عمل الكود وهو يعمل بالترتيب التالي

    فرز و تيب البيانات حسب العمود L التاريخ و الوقت

    تثبيت قيم التاريخ و اليوم بحيث تصبح بدون دوال

    اضافة الدوال للصفوف التي ليس بها دوال 

    Dim ER, RN1 As Range

    ActiveWindow.ScrollRow = 6
    Range("A5:O6000").Sort Key1:=Range("L5"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
For Each RN1 In Range("L5:M6000")
If RN1.HasFormula And RN1 <> "" Then _
RN1 = RN1.Value
Next
Range("L3:M3").Copy
ER = Application.CountA(Range("A:A")) + 9
For FR = 5 To ER
If Cells(FR, 12) = "" Then _
Cells(FR, 12).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Next 'FR
    Application.CutCopyMode = False

    مع التحية

    Export--TAAM1.xls

    • Like 1

    طريقة اضافة بحث بجزء من الاسم او اللقب

    في منتدى الاكسيل Excel

    قام بنشر

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

    بعد اذن الاخ هشام

    في الملف المرفق

    اكتب اي جزء من الاسم الذي تريدة

    سوف تعمل التصفية تلقائيا على استخراج المطلوب 

    Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$5" Then
Dim ER, FF, RN1 As Range
ER = ActiveSheet.UsedRange.Rows.Count + 9
Set RN1 = Range("A9:V" & ER)
FF = Range("B5").Text
If FF = "" Then
RN1.AutoFilter Field:=2
Else
FF = "*" & FF & "*"
RN1.AutoFilter Field:=2, Criteria1:=FF, Operator:=xlOr, _
    Criteria2:="="
End If
Range("B5").Select
End If
End Sub

    حساب عدد ايام العمل (1).xlsm

    • Like 2

    ترتيب جدول بحسب التاريخ الهجري

    في منتدى الاكسيل Excel

    قام بنشر

    ممكن تجرب تغيير نوع الخط للخلية

    راح يعطيك اشكال قد تكون اسهل للقرائة

    و حل آخر

    حدد الخلايا للتاريخ ثم

    اضغط Ctrl+1

    من تبويب رقم اعلى الشاشة

    اختار مخصص

    تظهر لك صيغة التاريخ زد عليها مسافات ثم موافق

    ان شاء الله تظبط

     

    5 ساعات مضت, فـهـد said:

    النسبة لأسماء الايام  ، فكما ذكرت في الرد السابق هناك فرقا ينقص يوما فعليا عن التاريخ الفعلي

    هل الأمر طبيعي ؟

     

    طبيعي

    انته تعرف انه التاريخ الهجري احيانا يفرق حتى مع تقويم ام القرى حسب رؤية الهلال

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

    بحيث تزيد او تنقص يوم حسب ما تكتب انته فيها 1 او -1

    ثم نضع كود برمجي بحيث يثبت قيم التاريخ التي تم حسابها حتى لا تتغير قيمة التاريخ عند تغييرك للقيمة في خانة فرق التاريخ

    س: هل تريد عمل كود الفرز و الترتيب بناء على نتائج العمليات الحسابية للتاريخ

    تحياتي و تقديري

     

    • Like 1

    ترتيب جدول بحسب التاريخ الهجري

    في منتدى الاكسيل Excel

    قام بنشر

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

     من بعد اذن الأستاذ القدير: نذار سليمان عيد

    و الذي تعلمت منه الكثير جزاه الله خيرا

     اخي الكريم

    الأستاذ نذار ابدع جدا في الكود الذي وضعه لك

    وهو عمل رائع يشكر عليه

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

     اخي الكريم

    اود ان اغير الفكرة

     كما تعلم ان الاكسل يتعامل مع الوقت و التاريخ بنظام رقمي

    لذلك من الأفضل ان نعمل ما يلي

    نحول التاريخ من هجري الى تاريخ ميلادي

    مع دمج خانة التاريخ و الوقت معا بحيث يعطينا صيغة وقت بنص طويل dd/mm/yyyy hh:mm

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

     من تنسيق الخلايا Ctrl+1 تستطيع تغيير الشكل الظاهر امامك الى شكل تاريخ هجري او شكل تاريخ ميلادي

     من التنسيق الشرطي تستطيع تغيير لون الخلية حيث انه يتعامل معها كرقم و ليس نص

     هذه الفكرة

    أتمنى ان تعمل الدالة الخاصة بتعديل التاريخ الهجري على جهازك

     شاهد المرفق

    و للحديث بقية

    لوضع التنسيق الشرطي

    و لوضع كود الفرز

      

    =VALUE(CONCATENATE("a";$C6;" ";SUBSTITUTE($E6;RIGHT($E6;2);"");":";RIGHT($E6;2)))

     

    Export--TAAM.xlsx

    • Like 1

    المساعده على اضافه فلتره بالاسم

    في منتدى الاكسيل Excel

    قام بنشر

    مرفق الملف مع الاكواد

    كود لمسح كامل النموذج

    اضغط على الفرشاة للتنظيف 

        Range("J2:M2").ClearContents
    Range("A8") = ""
    Range("B8") = ""
    Range("C8") = ""
    Range("E8") = ""
    Range("B11:H319").ClearContents
    ActiveWindow.LargeScroll Down:=-99

    كود للبحث

    اضغط على البحث

    تم اضافة خلايا جانبيه مع بعض الدوال لعمل الكود للبحث 

    Dim TC, RN1 As Range, RN2 As Range, RN3 As Range
    Range("J2:M2").ClearContents
For TC = 10 To 13
If Cells(3, TC) = "" Then
GoTo 9
Else
Cells(2, TC) = Cells(3, TC).Value
End If
9 Next 'tr
Set RN1 = Sheets("DATA").Range("B5:J55555")
Set RN2 = Sheets("Dates").Range("J1:M2")
Set RN3 = Sheets("Dates").Range("B10:H555")
RN1.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=RN2, CopyToRange:=RN3, Unique:=False

    انظر المرفق

    N BANK.xlsm

    • Like 2

    المساعده على اضافه فلتره بالاسم

    في منتدى الاكسيل Excel

    قام بنشر

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

    اخي الكريم

    طيب نحنة ممكن نعمل بحث شامل

    من تاريخ

    الى تاريخ

    اسم المستفيد: اذا تركته فارغ يعطيك كل المستفيدين خلال الفترة

    البيان: تكتب اي 3 احرف البيان تظهر لك البيان التي تحتوي على هذه الحروف خلال الفترة او انتركته فارغ يعطيك كل البيان الموجود خلال الفترة

    ان شاء الله بسيطة

     

    • Like 1

    تعديل علي كود ترحيل

    في منتدى الاكسيل Excel

    قام بنشر

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

    Sub فاتورة_بيع_للمخزن()
'
' فاتورة_بيع_للمخزن ماكرو
'
Dim FS As Worksheet, TS As Worksheet
Dim Q1
Set FS = Sheets(ActiveSheet.Name)
Set TS = Sheets("المخزن")

For FR = 5 To 69
Q1 = FS.Cells(FR, 5).Value
Q3 = FS.Cells(FR, 8).Value
For TR = 1 To 999
If TS.Cells(TR, 1) = Q1 Then
TS.Cells(TR, 3) = TS.Cells(TR, 3) - Q3
GoTo 9
End If
Next 'TR
9 Next ' FR
'
End Sub

Sub فاتورة_مورد_للمخزن()
'
' فاتورة_بيع_للمخزن ماكرو
'
Dim FS As Worksheet, TS As Worksheet
Dim Q1
Set FS = Sheets(ActiveSheet.Name)
Set TS = Sheets("المخزن")

For FR = 5 To 69
Q1 = FS.Cells(FR, 5).Value
Q3 = FS.Cells(FR, 8).Value
For TR = 1 To 999
If TS.Cells(TR, 1) = Q1 Then
TS.Cells(TR, 3) = TS.Cells(TR, 3) - Q3
GoTo 9
End If
Next 'TR
9 Next ' FR
'
End Sub

     

    • Like 1

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

    في منتدى الاكسيل Excel

    قام بنشر

    ‏الاربعاء‏، 26‏/3‏/1442هـ الموافق ‏11‏/11‏/2020م

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

     

    اخي الكريم

    كلامك صحيح يوجد تكرار للترحيل

    و انت لم تحدد سابقا في طلبك عدم التكرار للبيانات

    =====

    لذلك

    ان عدم تكرار البيانات في الترحيل هنا له 3 طرق

    1

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

    بحيث ان كل صف يتم ترحيله يتم مسح هذا الصف

    2

    يتم وضع رمز امام الصف الذي تم ترحيله

    مثل : مرحل او تم او Dun او رقم او شرطة او أي شيء آخر

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

    3

    الطريقة الاصعب

    يجب ان تحدد انت ماهو المتغير الذي لا يتكرر في بيانات أي صف

    مثل : رقم السند – نوع السند – الاسم

    ثم يتم تعديل الكود

    بحيث عند ذهابه للورقة التي مطلوب الترحيل لها يبحث في العمود المحدد الذي به المتغير الذي لا يتكرر – فاذا وجد هذا المتغير جود لا يرحل البيانات و اذا لم يكن موجود يقوم بترحيل البيانات الى الورقة المطلوبة

    مع التحيه

     

    آمل ان تكون وضحة الفكرة

    و عليك ان تحدد ماتريد

     

    • Like 1
×
×
  • اضف...

Important Information

  I accept