hassan rady قام بنشر يوليو 13, 2017 مشاركة قام بنشر يوليو 13, 2017 السلام عليكم ورحمة الله وبركاته اخوتي الاعزاء هل اجد لديكم حل لمشكلتي لدي عمود به ارقام مكررة وهذه الارقام تختلف كل شهر ربما تزيد وربما تقل اريد ان ارحل البيانات من الشيت الاول الى الشيت الثاني بمعادلة غير معادلات الصفيف لانها ثقيلة مرفق لكم مثال ارقام.rar رابط هذا التعليق شارك More sharing options...
ابراهيم الحداد قام بنشر يوليو 13, 2017 مشاركة قام بنشر يوليو 13, 2017 السلام عليكم ورحمة الله استخدم الكود التالى فهو اخف واسرع Sub TransNum() Dim LR As Long, R As Long, p As Long, x As Integer LR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row For R = 2 To LR x = WorksheetFunction.CountIf(Sheet1.Range("$A$2:A" & R), Sheet1.Range("A" & R)) If x = 1 Then p = p + 1 Sheet2.Cells(p + 1, 1) = Sheet1.Cells(R, 1) End If Next End Sub 1 رابط هذا التعليق شارك More sharing options...
hassan rady قام بنشر يوليو 13, 2017 الكاتب مشاركة قام بنشر يوليو 13, 2017 استاذي العزيز شكرا على الرد انا كنت عامل كده بالضبط بس ده يحتاج اضيف زر انا عايز لو في معادلة تكون خفيفة وتعمل اوتوماتك رابط هذا التعليق شارك More sharing options...
أفضل إجابة عبدالسلام ابوالعوافي قام بنشر يوليو 13, 2017 أفضل إجابة مشاركة قام بنشر يوليو 13, 2017 وعليكم السلام من عيوب الاكسل البطئ عندما تكون البيانات كبيرة .. ومن الطرق المفيدة في هذه الحالة هي استخدام لغة سيكول اليك الكود الاتي ليقوم بالترحيل بسرعة اكبر من المعادلات .. المثال في المرفق ملاحظة .. تمت التجربة علي اوفس 2013 وقد يحتاج الي تعديل مع النسخ الاخري Sub InQuery() Dim intLastR As Double Dim strSQL Dim Conn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim srtPath As String, strConn As String With Application .ScreenUpdating = False .DisplayStatusBar = False .Calculation = xlCalculationManual .EnableEvents = False End With intLastR = ActiveSheet.UsedRange.Rows.Count Sheets("Sheet2").Columns(1).ClearContents srtPath = ThisWorkbook.FullName strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & srtPath & ";" & _ "Extended Properties=""Excel 12.0 Macro;HDR=Yes;IMEX=1"";" intLastR = Sheets("Sheet1").UsedRange.Rows.Count Conn.Open strConn strSQL = "SELECT * From [Sheet1$A1:b" & intLastR & "] WHERE [Column1] = 1" Debug.Print strSQL Debug.Print Conn rs.Open strSQL, Conn Sheet2.Range("A2").CopyFromRecordset rs Sheet2.Columns(2).ClearContents rs.Close Conn.Close With Application .ScreenUpdating = True .DisplayStatusBar = True .Calculation = xlCalculationAutomatic .EnableEvents = True End With End Sub ارقام.rar 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 13, 2017 مشاركة قام بنشر يوليو 13, 2017 وعليكم السلام الموضوع خضني لما بصيت في الأكواد .. لكن لما شفت الملف المرفق .. جه في بالي إن الموضوع من غير أكواد ولا معادلات ولا أعمدة مساعدة .. ممكن ببساطة ننسخ العمود الأول في ورقة العمل الأولى ونلصقه في الورقة التانية ، ونعمل Remove Duplicates (موجودة في التبويب Data) .. وبس خلاص بس للأمانة أعجبني جداً كود أخي عبد السلام لأنه يتطرق لموضوع غاية في الأهمية وهو استخدام الـ SQL Connection أو ما يعرف بـ ADO رابط هذا التعليق شارك More sharing options...
hassan rady قام بنشر يوليو 13, 2017 الكاتب مشاركة قام بنشر يوليو 13, 2017 كل الشكر لكم احبتي ^__^ رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر يوليو 13, 2017 مشاركة قام بنشر يوليو 13, 2017 منذ ساعه, زيزو العجوز said: السلام عليكم ورحمة الله استخدم الكود التالى فهو اخف واسرع Sub TransNum() Dim LR As Long, R As Long, p As Long, x As Integer LR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row For R = 2 To LR x = WorksheetFunction.CountIf(Sheet1.Range("$A$2:A" & R), Sheet1.Range("A" & R)) If x = 1 Then p = p + 1 Sheet2.Cells(p + 1, 1) = Sheet1.Cells(R, 1) End If Next End Sub ربنا يبارك فيكم يارب الاستاذ زيزو والاستاذ عبد السلام لو تكرمت اريد شرح للكود وعايز سطر لمسح العمود المنقول اليه اولا بس للأمانة أعجبني جداً كود أخي عبد السلام لأنه يتطرق لموضوع غاية في الأهمية وهو استخدام الـ SQL Connection أو ما يعرف بـ ADO جزاك الله خيرا استاذ ياسر والاستاذ عبد السلام هل يمكن القاء مزيد من الضوء على هذا الموضوع رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يوليو 13, 2017 مشاركة قام بنشر يوليو 13, 2017 بعد اذن اساتذتنا الكرام هذا الكود اسرع قليلاً و اخف وزناً Sub Salim() Sheets("sheet2").Range("a:a").Clear Range("Table1[[#All],[NUMBER]]").AdvancedFilter Action:=xlFilterInPlace, Unique:=True Range("Table1[[#All],[NUMBER]]").SpecialCells(12).Copy Sheets("Sheet2").Range("A1") Application.CutCopyMode = False Sheets("Sheet1").ShowAllData End Sub رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر يوليو 13, 2017 مشاركة قام بنشر يوليو 13, 2017 6 ساعات مضت, سليم حاصبيا said: Range("Table1[[#All], مافائده رمز الشباك جزاكم الله خيرا ؟ رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان