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

مطلب مساعدة من خبراء الترحيل VBA


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

السلام عليكم

اخواني الاعزاء

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

الملف مرفق وبه بقيه الشرح

ارجو التكرم بالقاء نظرة

وشكرا

Desktop.rar

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

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

الغرض من الرقم واحد,لاني اريد ان يكون الترحيل داخل الجدول عدد(قطعه واحده) وليس اسم المنتج لكي يتمكن الجدول الذي اعددته من حساب عدد المنتجات المستخدمه. 

شكرا لتجوابك استاذ

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

السلام عليكم

تم إصلاح الكود كالتالي:

1- بإضافة مجال في الورقة سميته Implam_ تأخذ منه الخلية H6 بياناتها (اللون الأصفر)

2- يتم التعرف علي مكان اللصق (للمنسوخ) من العمود المقابل لذلك النطاق  (اللون الأزرق الباهت)

3- تم إضافة الجزء التالي للكود لإزاحة الجدول سطرا واحدا إذا كان مملؤا

'Check if Table is Full  >> Insert one Row
 With Sheets("Implants").[Table5]
    If WorksheetFunction.Sum(.Rows(.Rows.Count)) <> 0 Then
        .Rows(.Rows.Count).ListObject.ListRows.Add AlwaysInsert:=True
    End If
 End With

4- تم اختصار الكود بقدر الامكان

تفضل المرفق

 

ملف ماكرو أصلي - للمتدى2.rar

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

استاذ.. 

الفكرة بدات تعمل ولكن لدي بعض الاستفسارات

اولا :هل لابد من ووجود المجال (implant)الذي اضفته؟ لان طريقه ادخال رموز المنتجات في ورقه( scan) ستكون عن طريق جهازقارئ الباركود سوف يقراء كود المنتج ويضع رمزه مباشرة في خانه المنتج ثم يختار المستخدم رمزه الشخصي من 1 -5 ومن ثم الترحيل؟

و اذا كان لابد من وجود المجال،، هل اقوم باضافه باقي المنتجات تحت المجال الاصفر واماكن ترحيلها تحت المجال الازرق فقط, وسوف ينقل كل منتج الى مكانه؟ او كيف ستكون طريقه اضافه باقي المنتجات وهل يمكن اضافه باقي الاكواد لباقي المنتجات في نفس ال(sub)

 

ثانيا: عندما قمت بمسح الجدول (table5) في الورقة(implant) لم يعمل الترحيل داخل الجدول انما تحته واصبح يعطيني خطاء!! مثلا في حال نهايه الجرد سوف تمسح الجداول لبدايه جرد جديد  ارفقت الملف بعد مسح محتويات الجدول

 

اعلم اني اتعبتك

شكرا على تفاعلك يا ساتاذ

 

ملف ماكرو أصلي - بعد مسح الجدول.rar

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

السلام عليكم

أخي العزيز

أولا: معذرة لتأخر الرد لانشغالي الشديد

ثانيا: راجع الملف المرفق وبه ردا علي أسئلتك

تفضل المرفق

 

ملف ماكرو أصلي - للمتدي3.rar

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

  • 2 weeks later...

السلام عليكم

استاذ طارق شكرا جزيلا لك

الملف يعمل بشكل ممتاز بعد اخر التعديلات التي اضفتها مشكورا

 

يبدو اني بحاجه الى تعديل او اضافه بسيطه بعد تجربه البرنامج على ارض الواقع

الرجاء منك التكرم بالقاء نظره على الملف المرفق

مع خالص تقديري

Implant Items Control.rar

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

السلام عليكم
أخي الحبيب

عذرا لانشغالي وقد اضطررت لسفر مفاجئ

أرجو أن يكون هذا هو ماتريد

Sub Load()
'Stop screen updating
Application.ScreenUpdating = False
Dim trg As Range, tbl As Range

'Check if data is OK >> STOP & exit
If [j5].Value = Empty Then MsgBox "Scan Your Item Please!", vbCritical, "Loding not completed": End
If [i5].Value = Empty Then MsgBox "Enter User Code Please!", vbCritical, "Loding not completed": End

a = WorksheetFunction.Match([j5].Value, [A:A], 0)
sht = [C1].Offset(a - 1, 0)
col = [E1].Offset(a - 1, 0)
Set trg = Sheets(sht).Cells(9, col)

trg.Value = trg.Value + 1
[i5:o11].ClearContents

MsgBox "Loding has been done successfully", vbOKOnly, "Tank you."

End Sub

تفضل المرفق أيضا به الكود

 

Implant Items Control2.rar

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

السلام عليكم استاذ طارق ,, كل منا له مشاغله وانت تتكرم مشكورا بمساعدتنا دون مقابل فلا داعي للاعتذار جزاك الله عنا كل خير..

نعم الكود الذي عملته هو ما اريد بالضبط..

ولكني اضفت اضافه بسيطه لكي يقوم بتشغيل الكود تلقائيا بدون زر

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

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

واستخدمت الامر نسخ ولصق لكن لم يعمل([h5] = [j5]) يظهر خطأout of stack space

 

ارجو القاء نظرة على المرفق مشكورا

Implant Items Control2.rar

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

السلام عليكم

أخي العزيز

أكتب التعديل علي الكود الخاص ليكون كالتالي

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J5]) Is Nothing Then Exit Sub
If IsEmpty([J5]) Then Exit Sub
Call Load
[J5].Select
End Sub
رابط هذا التعليق
شارك

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