Khorsheed Omar قام بنشر فبراير 21 مشاركة قام بنشر فبراير 21 مساء الخير جميعاً لدي ملف اكسل و به العديد من الشيتات و الكثير من المعادلات في كل شيت و الملف المرفق مثال عنه احتاج أن احول المعادلات إلى أكواد VBA للتخلص من ثقل الملفات و لكم جزيل الشكر مصنف.xlsm رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر فبراير 21 مشاركة قام بنشر فبراير 21 جرب Function GetCustomerData(customerCode As String, dataSheet As Worksheet) As Variant Dim dataRange As Range Dim result As Variant Set dataRange = dataSheet.Range("A:C") result = Application.WorksheetFunction.Index(dataRange.Columns(3), _ Application.WorksheetFunction.Match(1, (dataRange.Columns(1) = [E1]) * (dataRange.Columns(2) = customerCode), 0)) GetCustomerData = IIf(customerCode = "", "", result) End Function Function GetCustomerTotal(customerCode As String, dataSheet As Worksheet) As Variant Dim dataRange As Range Dim result As Variant Set dataRange = dataSheet.Range("A:D") result = Application.WorksheetFunction.SumIfs(dataRange.Columns(4), dataRange.Columns(1), [E1], dataRange.Columns(2), customerCode) GetCustomerTotal = IIf(customerCode = "", "", result) End Function 1 رابط هذا التعليق شارك More sharing options...
Khorsheed Omar قام بنشر فبراير 22 الكاتب مشاركة قام بنشر فبراير 22 شكرا لك استاذ @abouelhassan لكن لم يعمل الكود بشكل جيد بعد تغيير اسماء الأعمدة أيضاً لكن ما ارغب به هو ان تكون نفس المعادلة موجودة بطريقة الكود لأنه يمكن أن يتواجد في الشيت جدوال اخرى ايما فوق الجدول الأول أو تحته و ايضا لا ارغب بتغيير اسماء الشيتات لأنها ستكون ثابتة رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر فبراير 23 مشاركة قام بنشر فبراير 23 الكود يعمل اخى ما تقوم بها المعادلات تحياتي رابط هذا التعليق شارك More sharing options...
Khorsheed Omar قام بنشر فبراير 24 الكاتب مشاركة قام بنشر فبراير 24 عفوا استاذ @abouelhassan لكن هل يمكنك تطبيقها على الملف كي اعرف بالضبط ما انا مخطئ فيه رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر فبراير 24 أفضل إجابة مشاركة قام بنشر فبراير 24 (معدل) وعليكم السلام ورحمة الله تعالى وبركاته بعد ادن الاخ @abouelhassan بما انك ترغب بتنفيد المعادلات على شكل كود اليك حل اخر رغم انني لا اعلم ما هي الطريقة المطلوبة لتنفيده Sub sheets_arrformula() 'Execute On All Worksheets Dim wsName As Worksheet, desWS As Worksheet Dim lr As Long, lige As Long Dim ws As Worksheet: Set ws = Sheets("بيانات رئيسية") For Each wsName In ThisWorkbook.Worksheets If wsName.Name Like "*-JAN" Then 'في حالة اظافة اوراق اخرى للمصنف 'Example February March.......... 1-Feb ,2-Feb.......1-Mar ,2-Mar 'If wsName.Name Like "*-*" Then With Application .ScreenUpdating = False .Calculation = xlManual Set desWS = ThisWorkbook.Sheets(wsName.Name) lr = ws.Columns("A:D").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Set a = ws.Range("A2:A" & lr): Set b = ws.Range("B2:B" & lr) Set c = ws.Range("C2:C" & lr): Set d = ws.Range("D2:D" & lr) f = ws.Name lige = desWS.Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1 desWS.Range("B2:C" & lige).ClearContents With desWS.Range("B2:B" & lige) .Formula2 = "=IFERROR(INDEX('" & f & "'!" & c.Address & ",MATCH(1,(E$1 ='" & f & "'!" & a.Address & ")*(A2 ='" & f & "'!" & b.Address & "),0)),"""")" .Value = .Value With desWS.Range("C2:C" & lige) .Formula2 = "=IF($B2<>"""",SUMIFS('" & f & "'!" & d.Address & ",'" & f & "'!" & a.Address & ",""=""&$E$1,'" & f & "'!" & c.Address & ",""=""&$B2,'" & f & "'!" & b.Address & ",a2),"""")" .Value = .Value End With End With .ScreenUpdating = True .Calculation = xlAutomatic End With End If Next wsName End Sub ولتنفيد الكود على الورقة النشطة Sub Test2() 'Execute On the Active Worksheet Dim lr As Long, lige As Long Dim ws As Worksheet: Set ws = Sheets("بيانات رئيسية") Dim desWS As Worksheet: Set desWS = ActiveSheet With Application .ScreenUpdating = False .Calculation = xlManual lr = ws.Columns("A:D").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row f = ws.Name Set a = ws.Range("A2:A" & lr): Set b = ws.Range("B2:B" & lr) Set c = ws.Range("C2:C" & lr): Set d = ws.Range("D2:D" & lr) If desWS.Name <> f Then lr = ws.Columns("A:D").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Set a = ws.Range("A2:A" & lr): Set b = ws.Range("B2:B" & lr) Set c = ws.Range("C2:C" & lr): Set d = ws.Range("D2:D" & lr) f = ws.Name lige = desWS.Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1 desWS.Range("B2:C" & lige).ClearContents With desWS.Range("B2:B" & lige) .Formula2 = "=IFERROR(INDEX('" & f & "'!" & c.Address & ",MATCH(1,(E$1 ='" & f & "'!" & a.Address & ")*(A2 ='" & f & "'!" & b.Address & "),0)),"""")" .Value = .Value With desWS.Range("C2:C" & lige) .Formula2 = "=IF($B2<>"""",SUMIFS('" & f & "'!" & d.Address & ",'" & f & "'!" & a.Address & ",""=""&$E$1,'" & f & "'!" & c.Address & ",""=""&$B2,'" & f & "'!" & b.Address & ",a2),"""")" .Value = .Value End With End With End If .ScreenUpdating = True .Calculation = xlAutomatic End With End Sub مصنف v2.xlsm تم تعديل فبراير 24 بواسطه محمد هشام. 2 رابط هذا التعليق شارك More sharing options...
Khorsheed Omar قام بنشر فبراير 24 الكاتب مشاركة قام بنشر فبراير 24 تمت شكرا جزيلاً 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.