Funktion der kan gennemløbe en liste i Excel

En Lopslags-funktion kunne måske anvendes - men skulle så kopieres til samtlige rækker. Hvormange er der?

En makro ville nok være mere hensigtsmæssigt.

Der er umiddelbart omkring 9.000 rækker...

Så er det en makro....

Hvor er Ordlisten placeret?

I samme ark, men i en anden fane

Forsøger (måske) om jeg kan konstruere en model....

Fantastisk!

Lad os nu se....

Rem Kode indsættes i VBA-vinduet i arket, der skal gennemløbes (Højreklik - vis programkode)
Rem Koden iværksættes fra arket - Alt+F8 afspil den viste makro

Rem DEFINITIONER - der kan tilpasses
Rem ================================
Const arkTilTest = "Ark1"
Const kolonneTilTest = "A"

Const arkOrdListe = "Ark2"
Const kolonneOrdListe = "D"

Const tegnVedMatch = "*"
Const kolonneVedMatch = "B"
Rem ================================

Dim kildeArk, listeArk
Sub startGennemløb()
    Application.ScreenUpdating = False

    Set kildeArk = ActiveWorkbook.Sheets(arkTilTest)
    Set listeArk = ActiveWorkbook.Sheets(arkOrdListe)
   
Rem Gennemløber kolonnen indtil blank mødes
    With kildeArk
        For række = 1 To 65000
            tekst = .Range(kolonneTilTest & CStr(række))
            If tekst <> "" Then
Rem Undersøg om ord findes i listen
                If findesOrd(tekst) = True Then
                    .Range(kolonneVedMatch & CStr(række)).Value = tegnVedMatch
                End If
            Else
                MsgBox ("Gennemløb afsluttet")
                Exit Sub
            End If
        Next række
    End With
   
    Application.ScreenUpdating = True
   
    kildeArk.Activate
End Sub
Private Function findesOrd(ord)
    With listeArk.Range(kolonneOrdListe & ":" & kolonneOrdListe)
        Set c = .Find(ord, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findesOrd = True
        Else
            findesOrd = False
        End If
    End With
End Function

Evt.: - send en mail (adresse under profil) - så fremsendes filen m/model