اذهب الي المحتوي
أوفيسنا

عندى قيمه فى حقل عايزه اقسمها لحقلين زى الصوره


safaa salem5
إذهب إلى أفضل إجابة Solved by Foksh,

الردود الموصى بها

 عندى حقل هيتكتب فيه قيمه من مقطعين عايزه بمجرد كتابة القيمة يتنقل المقطع الاقل لحقل 

low

والقيمه الاكبر لحقل

high

مع العلم ان شكل القيمه الاساسيه بيكون زى كدا

( 10 - 25)

او بدون اقواس

10 - 25

او بعلامه عشريه

( 10.4 - 25.7)

 

 

 

Screenshot_1.png

New Microsoft Access Database.accdb

تم تعديل بواسطه safaa salem5
رابط هذا التعليق
شارك

بالافتراض أن صيغة الرقم المكتوبة في الحقل الأول بهذا الشكل 25 - 10

Private Sub TextBox1_LostFocus()
    ' التحقق من أن مربع النص ليس فارغًا
    If Not IsEmpty(Me.TextBox1.Value) Then
        ' تحويل القيمة إلى عددين
        Dim values() As String
        values = Split(Me.TextBox1.Value, " - ")
        
        ' التحقق من أن هناك قيمتين مفصولتين بفاصلة "-"
        If UBound(values) = 1 Then
            ' تحويل القيم إلى أرقام
            Dim lowValue As Double
            Dim highValue As Double
            lowValue = CDbl(values(0))
            highValue = CDbl(values(1))
            
            ' تحديث قيم low و high في مربعي النص المستهدفين
            Me.low.Value = lowValue
            Me.high.Value = highValue
        Else
            ' رسالة تنبيه إذا كان التنسيق غير صحيح
            MsgBox "يرجى إدخال القيم بالتنسيق الصحيح (على سبيل المثال: 10 - 15)"
        End If
    End If
End Sub

حيث أن TextBox1 هو مربع النص الذي به القيمة سابقة ، وعند الخروج منه سينقل القيم تلقائيا للمربعين low و high .

لعدم توافر جهاز كمبيوتر حالياً ، أعلميني بالنتيجة.

رابط هذا التعليق
شارك

20 minutes ago, Foksh said:

بالافتراض أن صيغة الرقم المكتوبة في الحقل الأول بهذا الشكل 25 - 10

Private Sub TextBox1_LostFocus()
    ' التحقق من أن مربع النص ليس فارغًا
    If Not IsEmpty(Me.TextBox1.Value) Then
        ' تحويل القيمة إلى عددين
        Dim values() As String
        values = Split(Me.TextBox1.Value, " - ")
        
        ' التحقق من أن هناك قيمتين مفصولتين بفاصلة "-"
        If UBound(values) = 1 Then
            ' تحويل القيم إلى أرقام
            Dim lowValue As Double
            Dim highValue As Double
            lowValue = CDbl(values(0))
            highValue = CDbl(values(1))
            
            ' تحديث قيم low و high في مربعي النص المستهدفين
            Me.low.Value = lowValue
            Me.high.Value = highValue
        Else
            ' رسالة تنبيه إذا كان التنسيق غير صحيح
            MsgBox "يرجى إدخال القيم بالتنسيق الصحيح (على سبيل المثال: 10 - 15)"
        End If
    End If
End Sub

حيث أن TextBox1 هو مربع النص الذي به القيمة سابقة ، وعند الخروج منه سينقل القيم تلقائيا للمربعين low و high .

لعدم توافر جهاز كمبيوتر حالياً ، أعلميني بالنتيجة.

 

Screenshot_3.png

Screenshot_4.png

رابط هذا التعليق
شارك

انواع الحقول مختلفه

وانا عايزه القيمه الاساسيه 

MEMO

علشان المعدل الطبيعى فى بعض التحاليل مش شكل ثابت

زى كدا

Detection limit      1,5
Low titer   1,5 - 100,000
Moderate 100,000 - 1000,000
High titer    >1000,000

Just now, safaa salem5 said:

انواع الحقول مختلفه

وانا عايزه القيمه الاساسيه 

MEMO

علشان المعدل الطبيعى فى بعض التحاليل مش شكل ثابت

زى كدا

Detection limit      1,5
Low titer   1,5 - 100,000
Moderate 100,000 - 1000,000
High titer    >1000,000

لكن 80 فى المائه بالشكل دا

(1 - 20)

1 minute ago, safaa salem5 said:

انواع الحقول مختلفه

وانا عايزه القيمه الاساسيه 

MEMO

علشان المعدل الطبيعى فى بعض التحاليل مش شكل ثابت

زى كدا

Detection limit      1,5
Low titer   1,5 - 100,000
Moderate 100,000 - 1000,000
High titer    >1000,000

لكن 80 فى المائه بالشكل دا

(1 - 20)

عايزه يبقى فى اتاحه لكتابة النورمال باى شكل بس فى حالة كتابته بالطريقه المزكوره سابقا يحصل التقسيم

رابط هذا التعليق
شارك

6 minutes ago, Foksh said:

يعني ممكن يكون المحتوى في Reference نصي ورقمي ؟؟

اه

15 minutes ago, Foksh said:

جربي اكتبي القيم بدون الأقواس ، مثلاً 

10 - 25

 

فعلا لما شلت الاقواس اشتغلت 

بس عايزه اشغلها فى حالة وجود الاقواس او فى حالة عدم وجودها

تم تعديل بواسطه safaa salem5
رابط هذا التعليق
شارك

16 دقائق مضت, safaa salem5 said:

بس عايزه اضيف الاقواس

Private Sub TextBox1_LostFocus()
    ' التحقق من أن مربع النص ليس فارغًا
    If Not IsEmpty(Me.TextBox1.Value) Then
        ' تحويل القيمة إلى عددين بدون الأقواس
        Dim cleanedValue As String
        cleanedValue = Replace(Me.TextBox1.Value, "(", "")
        cleanedValue = Replace(cleanedValue, ")", "")
        Dim values() As String
        values = Split(cleanedValue, " - ")
        
        ' التحقق من أن هناك قيمتين مفصولتين بفاصلة "-"
        If UBound(values) = 1 Then
            ' تحويل القيم إلى أرقام
            Dim lowValue As Double
            Dim highValue As Double
            lowValue = CDbl(values(0))
            highValue = CDbl(values(1))
            
            ' تحديث قيم low و high في مربعي النص المستهدفين
            Me.low.Value = lowValue
            Me.high.Value = highValue
        Else
            ' رسالة تنبيه إذا كان التنسيق غير صحيح
            MsgBox "يرجى إدخال القيم بالتنسيق الصحيح (على سبيل المثال: 10 - 15)"
        End If
    End If
End Sub

جربي كده مع الأقواس

رابط هذا التعليق
شارك

4 minutes ago, Foksh said:
Private Sub TextBox1_LostFocus()
    ' التحقق من أن مربع النص ليس فارغًا
    If Not IsEmpty(Me.TextBox1.Value) Then
        ' تحويل القيمة إلى عددين بدون الأقواس
        Dim cleanedValue As String
        cleanedValue = Replace(Me.TextBox1.Value, "(", "")
        cleanedValue = Replace(cleanedValue, ")", "")
        Dim values() As String
        values = Split(cleanedValue, " - ")
        
        ' التحقق من أن هناك قيمتين مفصولتين بفاصلة "-"
        If UBound(values) = 1 Then
            ' تحويل القيم إلى أرقام
            Dim lowValue As Double
            Dim highValue As Double
            lowValue = CDbl(values(0))
            highValue = CDbl(values(1))
            
            ' تحديث قيم low و high في مربعي النص المستهدفين
            Me.low.Value = lowValue
            Me.high.Value = highValue
        Else
            ' رسالة تنبيه إذا كان التنسيق غير صحيح
            MsgBox "يرجى إدخال القيم بالتنسيق الصحيح (على سبيل المثال: 10 - 15)"
        End If
    End If
End Sub

جربي كده مع الأقواس

تمام الاخيره شغاله فى حالة اقواس اوبدون اقواس

بس بيرفض ادخال نص

 

انا عايزه اتاحه ادخال نص لو سمحت

هل ممكن استخلاص الارقام فى حالة وجود نص

لو عايز اشكال الريفرانس فى حالة وجود نص انا ممكن اجمعهملك

تقريبا 3 اشكال

 

رابط هذا التعليق
شارك

7 دقائق مضت, safaa salem5 said:

هل ممكن استخلاص الارقام فى حالة وجود نص

جربي التعديل الاخير

Private Sub TextBox1_LostFocus()
    ' التحقق من أن مربع النص ليس فارغًا
    If Not IsEmpty(Me.TextBox1.Value) Then
        ' التحقق من وجود الأقواس وإزالتها إن وجدت
        Dim cleanedValue As String
        cleanedValue = Me.TextBox1.Value
        If cleanedValue Like "*(*" And cleanedValue Like "*)*" Then
            cleanedValue = Replace(cleanedValue, "(", "")
            cleanedValue = Replace(cleanedValue, ")", "")
        End If
        
        ' تحويل القيمة إلى عددين
        Dim values() As String
        values = Split(cleanedValue, " - ")
        
        ' التحقق من أن هناك قيمتين مفصولتين بفاصلة "-"
        If UBound(values) = 1 Then
            ' تحويل القيم إلى أرقام
            Dim lowValue As Double
            Dim highValue As Double
            lowValue = CDbl(values(0))
            highValue = CDbl(values(1))
            
            ' تحديث قيم low و high في مربعي النص المستهدفين
            Me.low.Value = lowValue
            Me.high.Value = highValue
        Else
            ' رسالة تنبيه إذا كان التنسيق غير صحيح
            MsgBox "يرجى إدخال القيم بالتنسيق الصحيح (على سبيل المثال: 10 - 15)"
        End If
    End If
End Sub

 

رابط هذا التعليق
شارك

هو شغال تمام بس مش بيسمح بادخال النصوص بسبب الرساله دى


        Else
            ' رسالة تنبيه إذا كان التنسيق غير صحيح
            MsgBox "يرجى إدخال القيم بالتنسيق الصحيح (على سبيل المثال: 10 - 15)"
        End If
    End If
End Sub
رابط هذا التعليق
شارك

3 ساعات مضت, safaa salem5 said:

لو صعبه موضوع النص مع الرقم خليه بكره تفكر براحتك

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

غداً إن كان في العمر بقية نشوف الموضوع 

  • Like 1
رابط هذا التعليق
شارك

أخت @safaa salem5 ، تفضلي هذا التعديل الأخير على الكود ، في Reference

Private Sub reference_LostFocus()
If Not IsEmpty(Me.reference.Value) Then
    Dim inputText As String
    Dim i As Integer
    Dim currentChar As String
    Dim currentNumber As String
    Dim isNumberStarted As Boolean
    Dim numbersFound As Integer
    
    inputText = Me.reference.Value
    currentNumber = ""
    isNumberStarted = False
    numbersFound = 0
    
    For i = 1 To Len(inputText)
        currentChar = Mid(inputText, i, 1)
        
        If IsNumeric(currentChar) Then
            currentNumber = currentNumber & currentChar
            isNumberStarted = True
        ElseIf isNumberStarted Then
            numbersFound = numbersFound + 1
            If numbersFound = 1 Then
                Me.low.Value = currentNumber
            ElseIf numbersFound = 2 Then
                Me.high.Value = currentNumber
                Exit For
            End If
            currentNumber = ""
            isNumberStarted = False
        End If
    Next i
    
    If Len(Me.low.Value) = 0 Or Len(Me.high.Value) = 0 Then
        MsgBox "Error: No valid numeric values found"
    End If
End If
    End Sub

طبعاً هذا الكود بالإفتراض أن القيم الرقمية هي أرقام صحيحة وليست كسرية !

  • Like 1
رابط هذا التعليق
شارك

9 minutes ago, Foksh said:

أخت @safaa salem5 ، تفضلي هذا التعديل الأخير على الكود ، في Reference

Private Sub reference_LostFocus()
If Not IsEmpty(Me.reference.Value) Then
    Dim inputText As String
    Dim i As Integer
    Dim currentChar As String
    Dim currentNumber As String
    Dim isNumberStarted As Boolean
    Dim numbersFound As Integer
    
    inputText = Me.reference.Value
    currentNumber = ""
    isNumberStarted = False
    numbersFound = 0
    
    For i = 1 To Len(inputText)
        currentChar = Mid(inputText, i, 1)
        
        If IsNumeric(currentChar) Then
            currentNumber = currentNumber & currentChar
            isNumberStarted = True
        ElseIf isNumberStarted Then
            numbersFound = numbersFound + 1
            If numbersFound = 1 Then
                Me.low.Value = currentNumber
            ElseIf numbersFound = 2 Then
                Me.high.Value = currentNumber
                Exit For
            End If
            currentNumber = ""
            isNumberStarted = False
        End If
    Next i
    
    If Len(Me.low.Value) = 0 Or Len(Me.high.Value) = 0 Then
        MsgBox "Error: No valid numeric values found"
    End If
End If
    End Sub

طبعاً هذا الكود بالإفتراض أن القيم الرقمية هي أرقام صحيحة وليست كسرية !

طيب الارقام الكسريه نضيفها ازاى

1 minute ago, safaa salem5 said:

طيب الارقام الكسريه نضيفها ازاى

فى حالة ارقام كسريه بينقلها كدا

Screenshot_5.png

رابط هذا التعليق
شارك

:blink:

كنت متوقع ، على العموم تفضلي , ومرفق فيديو للتوضيح

Private Sub reference_LostFocus()
If Not IsEmpty(Me.reference.Value) Then
    Dim inputText As String
    Dim i As Integer
    Dim currentChar As String
    Dim currentNumber As String
    Dim isNumberStarted As Boolean
    Dim numbersFound As Integer
    Dim hasDecimal As Boolean
    
    inputText = Me.reference.Value
    currentNumber = ""
    isNumberStarted = False
    numbersFound = 0
    hasDecimal = False
    For i = 1 To Len(inputText)
        currentChar = Mid(inputText, i, 1)
        
        If IsNumeric(currentChar) Or currentChar = "." Then
            If currentChar = "." Then
                If hasDecimal Then
                    MsgBox "Error: Invalid numeric format"
                    Exit Sub
                Else
                    hasDecimal = True
                End If
            End If
            currentNumber = currentNumber & currentChar
            isNumberStarted = True
        ElseIf isNumberStarted Then
            numbersFound = numbersFound + 1
            If numbersFound = 1 Then
                Me.low.Value = currentNumber
            ElseIf numbersFound = 2 Then
                Me.high.Value = currentNumber
                Exit For
            End If
            currentNumber = ""
            isNumberStarted = False
            hasDecimal = False
        End If
    Next i
    
    If Len(Me.low.Value) = 0 Or Len(Me.high.Value) = 0 Then
        MsgBox "Error: No valid numeric values found"
    End If
End If
    End Sub

 

 

2023_12_12_210437.zip

  • Haha 1
رابط هذا التعليق
شارك

  • أفضل إجابة

أتمنى أن يكون هذا طلبك :rol:

 

Private Sub reference_LostFocus()
If Not IsEmpty(Me.reference.Value) Then
    Dim inputText As String
    Dim i As Integer
    Dim currentChar As String
    Dim currentNumber As String
    Dim isNumberStarted As Boolean
    Dim numbersFound As Integer
    Dim hasDecimal As Boolean
    
    inputText = Replace(Me.reference.Value, "(", "")
    inputText = Replace(inputText, ")", "")
    
    currentNumber = ""
    isNumberStarted = False
    numbersFound = 0
    hasDecimal = False
    
    For i = 1 To Len(inputText)
        currentChar = Mid(inputText, i, 1)
        
        If IsNumeric(currentChar) Or currentChar = "." Then
            If currentChar = "." Then
                If hasDecimal Then
                    MsgBox "Error: Invalid numeric format"
                    Exit Sub
                Else
                    hasDecimal = True
                End If
            End If
            currentNumber = currentNumber & currentChar
            isNumberStarted = True
        ElseIf isNumberStarted Then
            numbersFound = numbersFound + 1
            If numbersFound = 1 Then
                Me.low.Value = currentNumber
            ElseIf numbersFound = 2 Then
                Me.high.Value = currentNumber
                Exit For
            End If
            currentNumber = ""
            isNumberStarted = False
            hasDecimal = False
        End If
    Next i
    
    If numbersFound = 1 Then
        Me.high.Value = currentNumber
    End If
    
    If Len(Me.low.Value) = 0 Or Len(Me.high.Value) = 0 Then
        MsgBox "Error: No valid numeric values found"
    End If
End If
    End Sub

هذا الكود يدعم الأقواس أو بدونها ، ويدعم الأرقام الصحيحة والأرقام العشرية ، ويدعم ان كان في الحقل Reference حروف نصية أو لا .

رابط هذا التعليق
شارك

8 minutes ago, Foksh said:

أتمنى أن يكون هذا طلبك :rol:

 

Private Sub reference_LostFocus()
If Not IsEmpty(Me.reference.Value) Then
    Dim inputText As String
    Dim i As Integer
    Dim currentChar As String
    Dim currentNumber As String
    Dim isNumberStarted As Boolean
    Dim numbersFound As Integer
    Dim hasDecimal As Boolean
    
    inputText = Replace(Me.reference.Value, "(", "")
    inputText = Replace(inputText, ")", "")
    
    currentNumber = ""
    isNumberStarted = False
    numbersFound = 0
    hasDecimal = False
    
    For i = 1 To Len(inputText)
        currentChar = Mid(inputText, i, 1)
        
        If IsNumeric(currentChar) Or currentChar = "." Then
            If currentChar = "." Then
                If hasDecimal Then
                    MsgBox "Error: Invalid numeric format"
                    Exit Sub
                Else
                    hasDecimal = True
                End If
            End If
            currentNumber = currentNumber & currentChar
            isNumberStarted = True
        ElseIf isNumberStarted Then
            numbersFound = numbersFound + 1
            If numbersFound = 1 Then
                Me.low.Value = currentNumber
            ElseIf numbersFound = 2 Then
                Me.high.Value = currentNumber
                Exit For
            End If
            currentNumber = ""
            isNumberStarted = False
            hasDecimal = False
        End If
    Next i
    
    If numbersFound = 1 Then
        Me.high.Value = currentNumber
    End If
    
    If Len(Me.low.Value) = 0 Or Len(Me.high.Value) = 0 Then
        MsgBox "Error: No valid numeric values found"
    End If
End If
    End Sub

هذا الكود يدعم الأقواس أو بدونها ، ويدعم الأرقام الصحيحة والأرقام العشرية ، ويدعم ان كان في الحقل Reference حروف نصية أو لا .

انا ممتنه جدا لحضرتك تسلم على كل لحظه من وقتك ربنا يبارك فى عمرك

  • Thanks 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information