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

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
EM_ACC مجدى يونس-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة بحاجة الى كود ترحيل اكسيل اسئله واجابات


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





تعديل كود الاستاذ سليم الدالة VlookUp

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



10-07-2020 08:18 مساء
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 

الاساتذة الافاضل هذا الكود اهانى اياه اخى استاذ سليم ربنا يحفظه يارب
احتاج لتسريع الكود لانه فى حالة 6000 سطر ياخد وقت كبير
وفى حالة عدم ايجاد الرقم لا اريد كتابة #N/A
بل اريد الخلية فارغة

هذا هو الكود الرائع
Option Explicit

Sub My_formula()
Dim r%, RoA, Min_ro%, Rg As Range
With Sheets("Sheet2")
RoA = .Range("A1").CurrentRegion.Rows.Count
Set Rg = .Range("C1").CurrentRegion
  r = Rg.Rows.Count
  If r = 1 Then Exit Sub
  Min_ro = Application.Min(r, RoA)
  Rg.Offset(1).Resize(r - 1).Columns(3).ClearContents
  With Rg.Offset(1).Resize(Min_ro - 1).Columns(3)
    .Formula = _
   "=VLOOKUP(A2,Sheet1!$C$2:$D$10,2,0)"
   .Value = .Value
  End With
End With
End Sub

مع خالص الشكر وخالص الدعاء
 
 
  VlK_Om_Ham.xlsm   تحميل xlsm مرات التحميل :(5)
الحجم :(19.587) KB


10-07-2020 11:35 مساء
مشاهدة مشاركة منفردة [1]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif تعديل كود الاستاذ سليم الدالة VlookUp
هذا الكود سريع جداً 
50.000 صف حلال 0.85 جزء من الثانية
الشرط الاساسي لا فراغات في العمود الأول لان الكود يتوقف عند اول خلية فارغة 

Sub Other_macro()
Dim R%, RoA, i%
Dim F_rg As Range, Rg As Range
Dim S1 As Worksheet, S2 As Worksheet
Dim t
t = Timer
    With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
    End With
Set S1 = Sheets("Sheet1"): Set S2 = Sheets("Sheet2")
i = 2
With S2
.Range("C2", Range("E1").End(4)).ClearContents
 Do Until .Cells(i, 1) = vbNullString
   Set F_rg = S1.Range("C:C").Find(.Cells(i, 1), lookat:=1)
    If F_rg Is Nothing Then GoTo Next_i
    R = F_rg.Row
    With .Cells(i, 1)
      .Offset(, 2) = S1.Cells(R, "A")
      .Offset(, 3) = S1.Cells(R, "B")
      .Offset(, 4) = S1.Cells(R, "D")
    End With
Next_i:
    i = i + 1
   Loop

End With
   With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
    End With
    MsgBox "This Operation takes:" & Chr(10) & _
    (Timer - t) * 1000 & " Milli_Seconde"
End Sub
 
 
  VlK_Om_HaTimer.xlsm   تحميل xlsm مرات التحميل :(12)
الحجم :(28.698) KB


10-07-2020 11:47 مساء
مشاهدة مشاركة منفردة [2]
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 
look/images/icons/i1.gif تعديل كود الاستاذ سليم الدالة VlookUp
فعلا والله حضرتك مبدع مبدع مبدع
تسلم وتعيش يارب
مانتحرم منك ياغالى

11-07-2020 06:31 مساء
مشاهدة مشاركة منفردة [3]
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 
look/images/icons/i1.gif تعديل كود الاستاذ سليم الدالة VlookUp
استاذى الغالى  salim
ادرجت بياناتى فى الشيت 1 والشيت 2
7230 صف بدون فراعات
الكود اخد وقت كبير جدا هو اتنفذ ونفذ المطلوب
بس اخد وقت كبير جداااا
غيرت التنسيق الى ارقام والى تكست والى عام وبردو اخد وقت كبيررررررررررررررر
ايه السبب اخى فى الله
مشكور بارك الله فيك

11-07-2020 06:49 مساء
مشاهدة مشاركة منفردة [4]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif تعديل كود الاستاذ سليم الدالة VlookUp
ربما استخدام المصفوفات يسرع من الكود
جربي التالي
Sub Test()
    Dim a, x, ws As Worksheet, sh As Worksheet, i As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("Sheet1")
        Set sh = ThisWorkbook.Worksheets("Sheet2")
        a = sh.Range("A2:A" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Value
        ReDim b(1 To UBound(a, 1), 1 To 3)
        For i = LBound(a) To UBound(a)
            x = Application.Match(a(i, 1), ws.Columns(3), 0)
            If Not IsError(x) Then
               b(i, 1) = ws.Cells(x, 1).Value
               b(i, 2) = ws.Cells(x, 2).Value
               b(i, 3) = ws.Cells(x, 4).Value
            Else
                b(i, 1) = Empty: b(i, 2) = Empty: b(i, 3) = Empty
            End If
        Next i
        sh.Range("C2:E" & Rows.Count).ClearContents
        sh.Range("C2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
    Application.ScreenUpdating = True
End Sub

11-07-2020 07:16 مساء
مشاهدة مشاركة منفردة [5]
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 
look/images/icons/i1.gif تعديل كود الاستاذ سليم الدالة VlookUp
مشكور اخى فى الله اسرع شوية بس بياخد وقت طويل جدااا
مش عارفة المشكلة فى ايه فى التنسيق ولا ايه
اشكرك من كل قلبى

12-07-2020 04:30 صباحا
مشاهدة مشاركة منفردة [6]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif تعديل كود الاستاذ سليم الدالة VlookUp
بارك الله فيكي
قد تكون المشكلة في التنسيقات الكثيرة بالملف أو يوجد تلف بالملف يسبب مشاكل
حاولي حفظ الملف باسم آخر في مسار آخر ، لربما يساهم في حل المشكلة.




الكلمات الدلالية
تعديل ، الاستاذ ، سليم ، الدالة ، VlookUp ،


 










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

الساعة الآن 05:38 صباحا