اذهب الي المحتوي
أوفيسنا

توجيه المبلغ


إذهب إلى أفضل إجابة Solved by Ali Mohamed Ali,

الردود الموصى بها

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

في العامود D المبلغ - ارغب في نقلة للاعمدة حسب التوجية الموجود بالعامود E

مثال: مبلغ 5000ج سلفة شخصية التوجية علي احمد جمال

اتمنى ان اكون قد وضحت الفكرة ولكم منى جزيل الشكر وفائق الاحترام ،،،،

 

توجيه المبلغ.xlsx

رابط هذا التعليق
شارك

بعد اذن استاذي الكريم Ali Mohamed Ali

جرب الكود

Sub testttttttttt()
Dim x, y
Dim lr
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "e").End(3).Row
For x = 3 To lr
For y = 6 To 100
If Cells(x, "e").Text = Cells(2, y) Then
Cells(x, y).Value = Cells(x, "d").Value

End If
Next
Next
Application.ScreenUpdating = True

End Sub

 

  • Like 1
رابط هذا التعليق
شارك

بعد اذن اخي حسن مأمون

بواسطة هذا الكود تستطيع اختصار 94 حلقة تكرارية (y=6 to 100) في كل دورة من الـــ X من 1 الى Lr

اذن لوكان عدد الصفوف 100 صف فاننا نقوم بــ 94×100= 9400 حلقة تكرارية لا حاجه لها

يمكن هنا استعمال الدالة Match   او الدالة   Find لتحديد العامود الذي نريد الصاق قيمة الخلية المطلوب ولا حاجة للدورة ثانية من الحلقات التكراية(y)

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

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

هذا مثال عن الماكرو كما اتصوره هنا

Sub MY_code()
Dim x%, lr%, col%, Last_col%
Dim Find_cel As Range
Last_col = Cells(2, Columns.Count).End(1).Column
lr = Cells(Rows.Count, "e").End(3).Row
Range("F3").Resize(lr, Last_col - 5).Clear
For x = 3 To lr
    Set Find_cel = Rows(2).Find(Cells(x, "e"), lookat:=1)
    If Not Find_cel Is Nothing Then
     col = Find_cel.Column
     Cells(x, col) = Cells(x, "D")
    End If
 Next
    With Range("F3").Resize(lr, Last_col - 5).SpecialCells(2)
      .Borders.LineStyle = 1
      .Interior.ColorIndex = 6
      .Font.Bold = True
      .HorizontalAlignment = 3
    End With

End Sub

الملف مرفق

 

My_value.xlsm

  • Like 2
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information