קוד השוואה בין נתונים באקסל בווורד

[chagold]

יש לי 2 קבצים, אחד אקסל עם רשימת כתובות דוא"ל והשני מסמך וורד שבתוכו פיסקאות שכל פיסקא זה הרבה פרטים של אדם אחר, ואני צריך למצוא את כל הכתובות שנמצאות בוורד ואינן באקסל.
במילים אחרות לעשות לופ על האקסל ולחפש בוורד.
התעסקתי בעבר כמעט רק עם vba של access ולא עם וורד ואקסל, לכן אשמח לטיפה הכוונה איך הכי כדאי לעשות את זה? (ואולי עדיף להעביר לגוגל docs ולהשתמש בקודים שם?
תודה.

[yossiz]

@chagold אמר בקוד השוואה בין נתונים באקסל בווורד:

אני צריך למצוא את כל הכתובות שנמצאות בוורד ואינן באקסל.
במילים אחרות לעשות לופ על האקסל ולחפש בוורד.

אתה לא סותר את עצמך?
אם אתה מחפש את הכתובות שנמצאות בוורד ולא באקסל אז אתה צריך לעשות הפוך, לופ על הוורד ולחפש באקסל?

לעצם הענין, נראה לי שאפשר להשתמש בפתרון פשוט, תעשה חיפוש בוורד עבור כתובות מייל, תלחץ "בחר הכל", תעתיק את הרשימה לקובץ אקסל, תמיין, תשווה.

[chagold]

@yossiz סליחה.
אני צריך למצוא את כל הכתובות שנמצאות בוורד ואינן באקסל.
לשם כך אני צריך לסמן את הכתובות שנמצאות בוורד והשאר ישארו לא מסומנות.
במילים אחרות לעשות לופ על האקסל ולחפש בוורד.
הפתרון שלך לכאו' לא יעזור במקרה שלי (המתוקן).
סליחה ותודה.

[אוריי]

@chagold

יש לי קוד כזה שמחזיר בעמודה B האם הערך קיים בקובץ וורד לפי ערכים בעמודה A
זה הקוד
אני מאמין שתוכל לשפר אותו עוד

Sub FindName()

    Dim X
    X = 1
  
    Dim wrdApp As Object
    Dim wrdDoc As Object
    Set wrdApp = CreateObject("Word.Application")
        wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Open("C:\Users\sbhtk\Documents\ssss.docx")
    Dim FindWord As String
    Dim result As String
    
       Do While Range("A" & X).Value <> ""
   
    FindWord = Range("A" & X).Value
   ' MsgBox FindWord
    
    '// Defines selection for Word's find function
    wrdDoc.SelectAllEditableRanges
    
    '// Word Find Method Setup Block
    With wrdDoc.ActiveWindow.Selection.Find
        .Text = FindWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = 1 ' wdFindContinue (Word constant not defined in Excel)
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
'        .Style = ("choose your style to look for")
    End With
    
    '// Execute find method selects the found text if found
    wrdDoc.ActiveWindow.Selection.Find.Execute
    
    '// Store Selected text
    result = wrdDoc.ActiveWindow.Selection.Text
    
    '// Test if the selection string found match value required converted case for comparison
    If UCase(result) = UCase(FindWord) Then
        Range("B" & X).Value = "קיים"
    Else
        Range("B" & X).Value = "לא קיים"
    End If
    X = X + 1
    Loop
    '// Close and don't save application
    wrdApp.Quit SaveChanges:=0 ' wdDoNotSaveChanges (Word constant not defined in Excel)

End Sub

מקור

בהצלחה

[רחמים]

@chagold עדיין לכאורא אתה יכול לעשות את העצה של @yossiz ולחפש את כל המיילים בוורד, ולהעתיק ולהדביק באקסל, ולהסיר כפולים.

[chagold]

@אוריי אמר בקוד השוואה בין נתונים באקסל בווורד:

@chagold

יש לי קוד כזה שמחזיר בעמודה B האם הערך קיים בקובץ וורד לפי ערכים בעמודה A
זה הקוד
אני מאמין שתוכל לשפר אותו עוד

Sub FindName()

    Dim X
    X = 1
  
    Dim wrdApp As Object
    Dim wrdDoc As Object
    Set wrdApp = CreateObject("Word.Application")
        wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Open("C:\Users\sbhtk\Documents\ssss.docx")
    Dim FindWord As String
    Dim result As String
    
       Do While Range("A" & X).Value <> ""
   
    FindWord = Range("A" & X).Value
   ' MsgBox FindWord
    
    '// Defines selection for Word's find function
    wrdDoc.SelectAllEditableRanges
    
    '// Word Find Method Setup Block
    With wrdDoc.ActiveWindow.Selection.Find
        .Text = FindWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = 1 ' wdFindContinue (Word constant not defined in Excel)
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
'        .Style = ("choose your style to look for")
    End With
    
    '// Execute find method selects the found text if found
    wrdDoc.ActiveWindow.Selection.Find.Execute
    
    '// Store Selected text
    result = wrdDoc.ActiveWindow.Selection.Text
    
    '// Test if the selection string found match value required converted case for comparison
    If UCase(result) = UCase(FindWord) Then
        Range("B" & X).Value = "קיים"
    Else
        Range("B" & X).Value = "לא קיים"
    End If
    X = X + 1
    Loop
    '// Close and don't save application
    wrdApp.Quit SaveChanges:=0 ' wdDoNotSaveChanges (Word constant not defined in Excel)

End Sub

מקור

בהצלחה

@אוריי עובד מצויין, תודה.
יש אפשרות בקוד הזה ג"כ לעדכן את המילה בוורד (ולשמור)?

[אוריי]

@chagold
יש לי את הקוד שמעצב טקסט בוורד
אבל הבעיה היא שאני לא כזה מבין בקוד של וורד ואני לא יודע איך לבחור טקסט ספציפי מתוך מסמך (כלומר מה הקוד שעושה את זה)
אולי @רחמים יכתוב לי איך אני יכול לבחור במסמך טקסט ספציפי ואני ינסה לעשות לך גם משהו לזה
ועוד דבר שחסר לי זה איך להריץ את הקוד של הvba של הוורד מתוך עורך הויזואל ביסיק של אקסל

[chagold]

@אוריי הקוד הקודם ששלחת ניגש מתוך האקסל לוורד.
אם תוכל להעלות את הקוד השני של העיצוב ואני ינסה לשלב.
תודה.

[אוריי]

@chagold אמר בקוד השוואה בין נתונים באקסל בווורד:

@אוריי הקוד הקודם ששלחת ניגש מתוך האקסל לוורד.
אם תוכל להעלות את הקוד השני של העיצוב ואני ינסה לשלב.
תודה.

יהיה אבל חסר לך בכל אופן את הבחירה של הטקסט הספציפי

   Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With Selection.Font
        .Name = "+גוף"
        .Size = 11
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineDouble
        .UnderlineColor = -587137025
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = -687800321
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
        .SizeBi = 11
        .NameBi = "+גוף עברי"
        .BoldBi = False
        .ItalicBi = False
        .Ligatures = wdLigaturesNone
        .NumberSpacing = wdNumberSpacingDefault
        .NumberForm = wdNumberFormDefault
        .StylisticSet = wdStylisticSetDefault
        .ContextualAlternates = 0
    End With

[chagold]

@אוריי זה מעדכן

    Dim X
    X = 1
  
    Dim objWord

    Dim objDoc

    Dim objSelection

    Set objWord = CreateObject("Word.Application")
   
    objWord.Visible = True
    Set objDoc = objWord.Documents.Open("C:\Users\a\Downloads\Version 8.docx")



    objDoc.Activate


    Dim sel As Object
    

    
   
    Dim FindWord As String
    Dim result As String
    
       Do While Range("g" & X).Value <> ""
   
    FindWord = Range("g" & X).Value
   
   Set oSelection = objWord.Selection
   oSelection.Select



With objDoc.ActiveWindow.Selection
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    With .Find
        .Text = FindWord
        .Replacement.Text = "$$$$$$$$$$$$$" 'Hope you have declared it somewhere?
        .Forward = True
        .Wrap = 1 'wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        oSelection.Find.Execute Replace:=2  'wdReplaceAll
   End With
End With
    
    
    
    '// Execute find method selects the found text if found
    objDoc.ActiveWindow.Selection.Find.Execute
    
    '// Store Selected text
    result = objDoc.ActiveWindow.Selection.Text
    
    '// Test if the selection string found match value required converted case for comparison
    If UCase(result) = UCase(FindWord) Then
        Range("m" & X).Value = "כן"
    Else
        Range("m" & X).Value = "לא"
    End If
    X = X + 1
    Loop
    '// Close and don't save application
    objWord.Quit SaveChanges:=0 ' wdDoNotSaveChanges (Word constant not defined in Excel)