Excel - lav søjle med cases, der går igen i udvalgte søjler

Denne makro løse rproblem nr. 1

Sub Find()
'
' Makro1 Makro
' Makro indspillet 30-01-2002 af Richardt Veje Madsen
'

x = 1
antalrækker = 10

For n = 6 To antalrækker

    Cells(n, 1).Select
    værdi = Cells(n, 1).Value
    Selection.Copy
    Columns("B:B").Select
    On Error Resume Next
    If Selection.Find(What:=værdi, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate = True Then
       
        If Err Then
            Cells(x, 3).Value = værdi
            x = x + 1
        End If
    End If
Next n

End Sub

lille fejl:

Skift

"antalrækker = 10"

ud med disse to:

ActiveCell.SpecialCells(xlLastCell).Select
antalrækker = ActiveCell.Row

Du kan ikke matche søjle A og B med mindre du kan opstille nogle regler for, hvornår A = B.

Til rvm: Makroen kører i det uendelige, og opretter en søjle C med data fra søjle A "re-shuffled".

Til janvogt: jeg havde forestillet mig, at man matchede ved fx. at indsætte stjerner (**) - i eksemplet fx. "maskine*"?

Ja - jeg opdagede let lige *S* arbejder på sagen

Nu virker den *S* løser poblem 1 - jeg arbejder vider på problem 2 - har samme problem som janvogt, men hat ænkt at løse det med at sammenligne ord på 5 karakterer (skære resten væk)

Sub Find()
'
' Makro indspillet 30-01-2002 af Richardt Veje Madsen

x = 1

ActiveCell.SpecialCells(xlLastCell).Select
antalrækker = ActiveCell.Row

For n = 1 To antalrækker
   
    If Cells(n, 1) = "" Then
    Else
   
        Cells(n, 1).Select
        værdi = Cells(n, 1).Value
   
        With Range("B:B")
            Set c = .Find(værdi, LookIn:=xlValues)
            If Not c Is Nothing Then
                With Range("C:C")
                    Set d = .Find(værdi, LookIn:=xlValues)
                    If d Is Nothing Then
                            Cells(x, 3).Value = værdi
                            x = x + 1
                    End If
                End With
            End If
        End With

    End If

Next n

End Sub

Nuer der også en lille løsning på problem 2:

ub Find()
'
' Makro indspillet 30-01-2002 af Richardt Veje Madsen

x = 1

ActiveCell.SpecialCells(xlLastCell).Select
antalrækker = ActiveCell.Row

For n = 1 To antalrækker
   
    If Cells(n, 1) = "" Then
    Else
   
        Cells(n, 1).Select
        værdi = Cells(n, 1).Value
        '5 er antallet i strengen det skal være ens (abcde*)
        værdi1 = Left(Cells(n, 1).Value, 5)
        værdi1 = værdi1 & "*"
       
        With Range("B:B")
            Set c = .Find(værdi1, LookIn:=xlValues)
            If Not c Is Nothing Then
                With Range("C:C")
                    Set d = .Find(værdi1, LookIn:=xlValues)
                    If d Is Nothing Then
                            Cells(x, 3).Value = værdi
                            x = x + 1
                    End If
                End With
            End If
        End With

    End If

Next n

End Sub

Det ser ud til, at den virker! Tusind tak for hjælpen!!