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

[safaa salem5]

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

low

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

high

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

( 10 - 25)

او بدون اقواس

10 - 25

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

( 10.4 - 25.7)

 

 

 

New Microsoft Access Database.accdb

تم تعديل ديسمبر 11, 2023 بواسطه safaa salem5

[Foksh]

بالافتراض أن صيغة الرقم المكتوبة في الحقل الأول بهذا الشكل 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 .

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

[safaa salem5]

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 .

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

 

[Foksh]

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

10 - 25

 

[safaa salem5]

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

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

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)

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

[Foksh]

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

[safaa salem5]

6 minutes ago, Foksh said:

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

اه

15 minutes ago, Foksh said:

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

10 - 25

 

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

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

تم تعديل ديسمبر 11, 2023 بواسطه safaa salem5

[Foksh]

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

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

[safaa salem5]

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 اشكال

 

[Foksh]

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

 

[safaa salem5]

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

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

[safaa salem5]

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

 

 

[Foksh]

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

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

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

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

[Foksh]

أخت @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

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

[safaa salem5]

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:

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

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

[Foksh]

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

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

[safaa salem5]

بص كمان فى مشكله بسيطه لازم القوس الاخير يتكتب غير كدا الرقم التانى مش بينزل 

[Foksh]

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

 

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 حروف نصية أو لا .

[safaa salem5]

8 minutes ago, Foksh said:

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

 

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 حروف نصية أو لا .

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

[safaa salem5]