نجوم المشاركات

Try Sub Test() Dim colSource, colTarget, ws As Worksheet, sh As Worksheet, lr As Long Set ws = ThisWorkbook.Worksheets(1) Set sh = ThisWorkbook.Worksheets(2) lr = ws.Cells(Rows.Count, "C").End(xlUp).Row colSource = Array("C:E", "H", "K", "F") colTarget = Array("D10", "L10", "N10", "P10") PopulateArray ws, sh, 14, lr, colSource, colTarget End Sub Public Sub PopulateArray(ByVal wsSource As Worksheet, ByVal shTarget As Worksheet, ByVal sRow As Long, ByVal lr As Long, ByVal rangesToPopulate, ByVal columnMappings) Dim arr, rangeColumns, rng As Range, i As Long Application.ScreenUpdating = False For i = LBound(rangesToPopulate) To UBound(rangesToPopulate) If InStr(1, rangesToPopulate(i), ":") > 0 Then rangeColumns = Split(rangesToPopulate(i), ":") Set rng = wsSource.Range(rangeColumns(0) & sRow & ":" & rangeColumns(1) & lr) Else Set rng = wsSource.Range(rangesToPopulate(i) & sRow).Resize(lr - sRow + 1) End If arr = rng.Value shTarget.Range(columnMappings(i)).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr Next i Application.ScreenUpdating = True End Sub

Try Sub Test() Const sRow As Long = 6 Dim a, b, x, rng As Range, sCol As String, lr As Long, i As Long Application.ScreenUpdating = False With ActiveSheet lr = .Cells(Rows.Count, "C").End(xlUp).Row Set rng = .Range("M3:V3") a = .Range("C" & sRow & ":C" & lr).Value b = .Range("L" & sRow & ":L" & lr).Value rng.Offset(1).Resize(lr - sRow + (sRow - rng.Row)).ClearContents For i = LBound(a) To UBound(a) x = Application.Match(a(i, 1), .Rows(rng.Row), 0) If Not IsError(x) Then .Cells(i + sRow - 1, x).Value = b(i, 1) Next i With rng.Offset(1) sCol = Split(rng.Cells(1).Address, "$")(1) .Formula = "=SUM(" & sCol & sRow & ":" & sCol & lr & ")" .Value = .Value End With End With Application.ScreenUpdating = True End Sub

Try Sub Test() Dim arr, rng As Range, i As Long, j As Long Set rng = Range("H9:N" & Cells(Rows.Count, "H").End(xlUp).Row) arr = rng.Value For i = LBound(arr, 1) To UBound(arr, 1) For j = LBound(arr, 2) To UBound(arr, 2) arr(i, j) = Round(arr(i, j) / 1000, 2) Next j Next i rng.Value = arr End Sub

تفضل أخي الكريم Private Sub TextBox3_Change() TextBox4 = IIf(TextBox1 = "", 1, TextBox1) * IIf(TextBox2 = "", 1, TextBox2) * IIf(TextBox3 = "", 1, TextBox3) End Sub Private Sub TextBox2_Change() TextBox4 = IIf(TextBox1 = "", 1, TextBox1) * IIf(TextBox2 = "", 1, TextBox2) * IIf(TextBox3 = "", 1, TextBox3) End Sub Private Sub TextBox1_Change() TextBox4 = IIf(TextBox1 = "", 1, TextBox1) * IIf(TextBox2 = "", 1, TextBox2) * IIf(TextBox3 = "", 1, TextBox3) End Sub بالنسبة لـ 0.25*0.23*0.26 يضرب تماما ولكن اعتقد انه يجب عند كتابة الرقم تبدأ بـ 0 تم . ثم بقية الرقم

وعليكم السلام ربما مخزن 2023.xls

سبق وأن شاركت في موضوع لك سابق لنفس المشكلة ، ثم اختفيت دون أن تذكر النتيجة. لا بأس يا أخي ، لتختصر الوقت والجهود ارفع مثالا به مشكلتك وسنقوم بحلها وتوضيح السبب.

t11 (1).accdb

تفضل أخي . مذبح البركة-3.accdb

عليكم السلام ملف استدعاء.rar

You can change this line Set rng = Range("H9:N" & Cells(Rows.Count, "H").End(xlUp).Row) to Set rng = Selection Now you can select one cell or more and run the code to do the task for you

استاذ ابو عبد الرحمن اشرف انت دائما مبدع الله ينور بصيرتك ويوفقك .

تفضل هذي الفكرة t11.accdb

احسنت اخى عاجز عن الشكر تحياتى لك ولكل شعبنا فى البحرين

تفضل أخي الطلب الاول بيفتح مع البرنامج. اما الطلب الثاني افتح النموذج (بيع وبون) بتحصل عميل اسمه (--دفع فوري--) اختاره وادخل البيانات وطالع النتيجة . واليك المرفق . مذبج البركة-2.accdb

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

اخي الكريم ابحث في المنتدى تجد العديد من هذه الافكار مثل هذه

السلام عليكم استاذ @Eng.Qassim شكرا للمتابعة وتم عمل اللازم والمقارنة مع موقع (Age Calculator) اتمنى تدقيق الملف بصورته النهائية وابداء الملاحظة ان وجدت اخي @ابراهيم_ لمتابعة الموضوع والملف الجديد تحياتي test.accdb

اخذت الجدول والنموذج في قاعدة بيانات العقارات الخاص بي واشتغلت مية بالمية بارك الله فيك اخي الحبيب الغالي

تعديل نسخة ٢٠٢٣ مجموعات الدعم أحمد الرشيدي-1.xlsx

You have to be specific from the beginning of the topic Sub Test() Dim lr As Long With ActiveSheet lr = Cells(Rows.Count, "C").End(xlUp).Row SumValuesBySearchKeys .Range("C6:C" & lr), .Range("L6:L" & lr), .Range("M3:V3") End With End Sub Public Sub SumValuesBySearchKeys(ByVal searchRange As Range, ByVal sumRange As Range, ByVal searchKeysRange As Range) Dim data(), a(), b(), out(), dic As Object, dataCols As Object, i As Long data = searchKeysRange.Value a = searchRange.Value b = sumRange.Value Set dic = CreateObject("Scripting.Dictionary") For i = LBound(a, 1) To UBound(a, 1) If Not dic.Exists(a(i, 1)) Then dic.Add a(i, 1), b(i, 1) Else dic(a(i, 1)) = dic(a(i, 1)) + b(i, 1) Next i ReDim out(1 To 1, 1 To UBound(data, 2)) Set dataCols = CreateObject("Scripting.Dictionary") For i = LBound(data, 2) To UBound(data, 2) If Not dataCols.Exists(data(1, i)) Then dataCols.Add data(1, i), i out(1, i) = dic(data(1, i)) Next i searchKeysRange.Offset(1, 0).Value = out End Sub

السلام عليكم ورحمه الله وبركاته جرب الكود التالي Me.Textbox4 = Val(Textbox1) / Val(Textbox3) / Val(Textbox2) * Val(ComboBox3) * Val(ComboBox1) * Val(ComboBox2)

أخى الفاضل / عباس السماوي تفضل الملف 2007 وشكرا على كلامكم الطيب أخى الفاضل / فضل 1 تفضل الملف 2003 الشهادات 2.rar الشهادات 2003.rar