نقل ارقام من معادلات

[بلانك]

عند نقل جدول1 الذي به هذه الارقام 
الى جدول 2 لا يتم تحويلها الى
  اسماء في الجدول 3  ماالسبب ؟؟؟  معلومه هذة الارقام تم نسخها من معادلات من جدول اخر... وعند كتابة ارقام في الجدول 2 يدوي ينفذ الامر .... ولا ادري ما السبب؟؟؟؟؟؟؟؟

تحويل اللجان الى أسماء _ ا.xlsm

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

السلام عليكم 

السبب هو وجود مسافات قبل الارقام وهذا يحدث عادة عند نسح ارقام ناتجة عن معادلات

 

الحل  كل القيم تتحول إلى نصوص (CStr) وتُزال الفراغات (Trim)  وهذا يضمن التطابق حتى لو كانت القيم أرقام أو نصوص أو ناتجة عن معادلات.

اليك الكود المعدل

Sub تحويل_اللجان_الى_اسماء_Turbo()

    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim r As Long, c As Long
    Dim lastRowMain As Long, lastRowSearch As Long
    Dim رقم_اللجنة As String, اسم_اللجنة As String, اسم_المراقب As String
    Dim فارق_الاعمدة As Long: فارق_الاعمدة = 12
    Dim cell As Range
    
    lastRowSearch = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row
    ws.Range("P3:X" & lastRowSearch).ClearContents
    
    lastRowMain = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    lastRowSearch = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row
    
    For r = 3 To lastRowMain
        
        اسم_المراقب = Trim(CStr(ws.Cells(r, "B").Value))
        
        For c = 4 To 12
            
            رقم_اللجنة = Trim(CStr(ws.Cells(r, c).Value))
            
            If رقم_اللجنة <> "" Then
                
                For Each cell In ws.Range("C3:C" & lastRowMain)
                    If Trim(CStr(cell.Value)) = رقم_اللجنة Then
                        
                        اسم_اللجنة = Trim(CStr(ws.Cells(cell.Row, "B").Value))
                        
                        Dim صف_المراقب As Range
                        For Each صف_المراقب In ws.Range("N3:N" & lastRowSearch)
                            If Trim(CStr(صف_المراقب.Value)) = اسم_المراقب Then
                                ws.Cells(صف_المراقب.Row, c + فارق_الاعمدة).Value = اسم_اللجنة
                                Exit For
                            End If
                        Next صف_المراقب
                        
                        Exit For
                    End If
                Next cell
                
            End If
            
        Next c
        
    Next r

End Sub

 

تم تعديل منذ 1 ساعه بواسطه عبدالله بشير عبدالله

[بلانك]

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