مساحة

[mk_mk_79]

السلام عليكم جميعا اعضاء المنتدى 

الرجاء تفريغ المساحة كما موضح بالخلية المظللة باللون الاصفر كما هو موضح بالملف المرفق علما بأن الملف يحتوى على 40000 خلية 

مساحة.xlsx

[hegazee]

و عليكم السلام و رحمة الله و بركاته.   حسب ما فهمت فأنت تريد تحويل المتر المربع لمساحات فدان و قيراط و سهم ثم عمل تفقيط بذلك. تم عمل اللازم بالملف المرفق

مساحة.xlsm

[mk_mk_79]

لا حضرتك مش هو المطلوب 

المطلوب ان فى خانة المبانى لو مكتوب قيمة فى عمود المبانى مثلا 420.5 تكتب فى عامود المساحة 420.50 م2 

ولو فى عامود الزراعة مكتوب فى خانة الفدان 6 وخانة القيراط 3 وخانة السهم 2 تكتب فى المساحة 6 فدان و3قيراط و2سهم 

[hegazee]

. تم استخدام المعادلة التالية لاظهار الناتج. تفضل

=IF(L10<>""; L10 & "فدان "; "") & IF(K10<>""; K10 & "قيراط "; "") & IF(J10<>""; J10 & "سهم "; "") & IF(I10<>""; I10 & "م²"; "")

مساحة.xlsx

تم تعديل ديسمبر 14 بواسطه hegazee

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته 

بإستخدام الأكواد يمكنك تجربة هدا 

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ExitApp
    Application.EnableEvents = False

    Dim tmp() As Variant, ColArr As Variant, lastRow As Long, _
    UnitsArr As Variant, i As Long, j As Integer, tbl As String
    Dim srcWS As Worksheet: Set srcWS = Me

    If Not Intersect(Target, Me.Range("I:L")) Is Nothing Then
        UnitsArr = Array("م²", "سهم", "قيراط", "فدان")

        With srcWS
            lastRow = .Columns("I:L").Find(What:="*", _
            SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
            If lastRow < 10 Then Exit Sub

            ColArr = .Range("I10:L" & lastRow).Value
            ReDim tmp(1 To lastRow - 9, 1 To 1)

            For i = 1 To UBound(ColArr, 1)
                tbl = ""
            For j = 1 To 4
                If IsNumeric(ColArr(i, j)) And ColArr(i, j) > 0 Then
                    tbl = tbl & IIf(tbl <> "", " و ", "") & ColArr(i, j) & " " & UnitsArr(j - 1)
                End If
            Next j
            tmp(i, 1) = tbl
        Next i

        With .Range("M10:M" & lastRow)
            .Value = tmp
            .ReadingOrder = xlRTL
        End With
    End With
 End If

ExitApp:
    Application.EnableEvents = True
End Sub

 

مساحة.xlsb

[mk_mk_79]

اخى العزيز محمد هشام . دائما تبهرنى باكوادك 

هو هذا الذى اريده تماما . بس فى تعديل بسيط عايزه فى الزراعة يكتب الفدان الاول والقيراط ثانيا والسهم ثالثا

لتصبح 3 فدان و21 قيراط و 3 سهم 

[عبدالله بشير عبدالله]

السلام عليكم 

بعد اذن  الاساتذة الاكارم

معادلة

=IF(L10>0;L10&" فدان";"") & IF(AND(L10>0;K10>0);" و ";"") & IF(K10>0;K10&" قيراط";"") & IF(AND(OR(L10>0;K10>0);J10>0);" و ";"") & IF(J10>0;J10&" سهم";"") & IF(AND(OR(L10>0;K10>0;J10>0);I10>0);" و ";"") & IF(I10>0;I10&" م²";"")

الملف

مساحة.xlsx

[محمد هشام.]

If Not Intersect(Target, Me.Range("I:L")) Is Nothing Then
        UnitsArr = Array("فدان", "قيراط", "سهم", "م²")

        With srcWS
            lastRow = .Columns("I:L").Find(What:="*", _
            SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
            If lastRow < 10 Then Exit Sub

            ColArr = .Range("I10:L" & lastRow).Value
            ReDim tmp(1 To lastRow - 9, 1 To 1)

            For i = 1 To UBound(ColArr, 1)
                tbl = ""
                For j = 4 To 1 Step -1
                    If IsNumeric(ColArr(i, j)) And ColArr(i, j) > 0 Then
                        tbl = tbl & IIf(tbl <> "", " و ", "") & ColArr(i, j) & " " & UnitsArr(4 - j)
                    End If
                Next j
                tmp(i, 1) = tbl
            Next i

 

مساحة2.xlsb

[mahmoud nasr alhasany]

احسنت  ا / محمد هشام.