اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر

الإخوة الكرام.. بعد تحيتي لكم جميعا، وتقديري للسادة القائمين على هذا المنتدى المبارك..

صادفتني مشكلة أثناء عملي في جدول في إحدى خلاياه أرقام أجزاء مع رقم الصفحة، على صورة 2/120، والمطلوب أن تكون الصورة كالتالي: 2/ 120، 130، 150، 3/ 170، 180، وهكذا، بحيث لا يتكرر رقم الجزء، فلا يكون: 2/ 120، 2/130، 2/150، 3/ 170، 3/180.

لكن الملف عندي فيه تكرار رقم الجزء (2، 3)، وهذا غير مطلوب.

والسؤال: هل هناك طريقة غير يدوية يتم فيها تحديد هذه المواضع التي تكرر فيها رقم الجزء في خليه واحدة؟

  • 1 month later...
قام بنشر (معدل)

بارك الله فيك أستاذ تومي، لكن أنا عملت ماكرو يقوم بتمييز أرقام الأجزاء المكررة باللون الأرجواني، فيجدد الماكرو كل أرقام الأجزاء المكررة، ليقوم الباحث بالنظر إلى ما يحتاج حذفا فيجذفه، لكنة ليس دقيقا مائة في المائة، وهذا هو الماكرو لمن أراد:

Sub رقمجزءمكرر()

'
' رقمجزءمكرر Macro
'
'
  
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "/"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.SelectColumn
    Selection.Font.Color = wdColorAutomatic
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdLine
    
    
   For i = 1 To 1000
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorAutomatic
    With Selection.Find
        .Text = "/"
        .Replacement.Text = "*"
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
       If Selection.Find.Execute = False Then MsgBox "تم تغيير رقم الجزء المكرر إلى اللون الأرجواني": End
    
   
    
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdWord, Count:=2, Extend:=wdExtend
    Selection.Font.Color = wdColorRed
   
    mm = Selection.Text
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    
    
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorAutomatic
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = 10498160
    With Selection.Find
        .Text = mm
        .Replacement.Text = "^&"
        .Forward = False
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute replace:=wdReplaceAll
     
    With Selection.Find
        .Text = "/"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
   
    End With
  
   
   Selection.Find.Execute
    
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
   
  Selection.HomeKey Unit:=wdStory
    Selection.MoveRight Unit:=wdCell
   
    Selection.HomeKey Unit:=wdLine

Next i

End Sub

تم تعديل بواسطه أبو عاصم المصري
قام بنشر

هذا الماكرو بعد ضبطه تماما، فهو يقوم بتحديد كل أرقام الأجزاء (المجلدات) المكررة، وتلوينها باللون الأرجواني:

Sub رقمجزءمكرر()

'
' رقمجزءمكرر Macro
'لا بد أن يكون الكلام في جدول
'ماكرو يقوم بتحديد أرقام الأجزاء (المجلدات) المكررة، ويقوم بتلوينها باللون الأرجواني لحذفها، أو إجراء ما يلزم
  
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "/"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.SelectColumn
    Selection.Font.Color = wdColorAutomatic
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdLine
    
    
   For i = 1 To 1000
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorAutomatic
    With Selection.Find
        .Text = "/"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchPrefix = True
        .MatchSuffix = True
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
       If Selection.Find.Execute = False Then MsgBox "تم تغيير رقم الجزء المكرر إلى اللون الأرجواني": End
    
   
    
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    
    
    Selection.MoveLeft Unit:=wdWord, Count:=2, Extend:=wdExtend
    Selection.Font.Color = wdColorRed
   
    mm = Selection.Text
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    
    
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorAutomatic
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = 10498160
    With Selection.Find
        .Text = mm
        .Replacement.Text = "^&"
        .Forward = False
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute replace:=wdReplaceAll
     
    With Selection.Find
        .Text = "/"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
   
    End With
  
   
   Selection.Find.Execute
    
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
   
  Selection.HomeKey Unit:=wdStory
    Selection.MoveRight Unit:=wdCell
   
    Selection.HomeKey Unit:=wdLine

Next i

End Sub

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information