mohamed322 قام بنشر أبريل 19, 2020 مشاركة قام بنشر أبريل 19, 2020 عدم تكرار الموظف ودمجة فى خلية واحدة عدم تكرار الموظف.xls رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر أبريل 19, 2020 أفضل إجابة مشاركة قام بنشر أبريل 19, 2020 جرب هذا الماكرو Option Explicit Sub No_Duplicates() Dim Dic As Object Dim Mmax%, i% Dim SH As Worksheet Set SH = Sheets("Sheet1") Set Dic = CreateObject("Scripting.Dictionary") With SH If .Range("E1").CurrentRegion.Rows.Count > 1 Then _ Range("E1").CurrentRegion.Offset(1).ClearContents Mmax = .Cells(Rows.Count, 1).End(3).Row i = 2 Do Until i > Mmax If .Cells(i, 1) <> vbNullString Then If Not Dic.exists(.Cells(i, 1).Value) Then Dic(.Cells(i, 1).Value) = IIf(IsNumeric(.Cells(i, 2)), _ .Cells(i, 2), 0) Else Dic(.Cells(i, 1).Value) = _ Dic(.Cells(i, 1).Value) + _ IIf(IsNumeric(.Cells(i, 2)), _ .Cells(i, 2), 0) End If End If i = i + 1 Loop If Dic.Count Then .Range("e2").Resize(Dic.Count) = _ Application.Transpose(Dic.keys) .Range("F2").Resize(Dic.Count) = _ Application.Transpose(Dic.items()) End If End With End Sub الملف مرفق No_tekrar.xlsm 2 رابط هذا التعليق شارك More sharing options...
mohamed322 قام بنشر أبريل 19, 2020 الكاتب مشاركة قام بنشر أبريل 19, 2020 شكرااااااااااااااااااا جداااااااااااا بارك الله فيكم 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.