Finde ens data i en kollonne vha. VBA

Du kan lave en ny kolonne og indsætte en formel, som kun indsætter navnet, når der dukker et nyt navn op.

Formlen kunne f.eks. se sådan ud: =HVIS(A2<>A1;A2;"")
Den skal selvfølgelig kopieres ned så længe der er data.

Jeg ved godt at man kan gøre det på den måde, men problemet er at dataene hentes ind i Excel vha. VBA-kode fra en database. Kunne man ikke konvertere formlen til VBA?

Du kan fyre denne lille makro af efter importen.
Her tror makroen at dine data starter i Sheet1 celle A1 - ret selv på det.

Husk altid at lege på en kopi fil....!

Public Sub RemoveDoubleText()
    Dim rCell As Range
    Dim sText As String
   
    sText = ""
    For Each rCell In Worksheets("Sheet1").Range("A1").CurrentRegion.Columns(2).Cells
        If rCell.Value = sText Then
            rCell.Value = ""
        Else
            sText = rCell.Value
        End If
    Next rCell
End Sub

Jeg skal ikke kun have fjernet værdier som forekommer mere end en gang. Det skal også være sådan, at de gentagne værdier splittes til et felt. Sådan noget i retning af

Do While (i = 0)
  If rCell.Value(Feltet_Ovenover) = (Dette_Felt) Then
      Felt(Feltet_Ovenover:Dette_Felt).Merge
  End If
Loop

Er det muligt?

Mener du således ?

01,02,03,04,05  Adobe
06,07,08,09,10  Microsoft
11              Google
12              Netscape
13,14,15        Altavista

Du er velkommen til at sende et LILLE ark, så jeg kan se hvordan du gerne vil have det til at se ud. fd@win-consult.com

flemmingdahl >> Sendt

Så skulle den være på plads :-)

Public Sub RemoveDoubleText()
    Dim rCell As Range
    Dim sText As String
    Dim lRow As Long
    Dim lMaxRows As Long
   
    sText = ""
    lMaxRows = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
    For Each rCell In ActiveSheet.Range("A1").CurrentRegion.Columns(2).Cells
        If rCell.Value = sText Then
            With rCell
                .Value = ""
                If .Row = lMaxRows Then
                    MergeCells lRow, .Row, .Column
                End If
            End With
        Else
            With rCell
                If .Row > 2 Then
                    MergeCells lRow, .Row - 1, .Column
                End If
                sText = .Value
                lRow = .Row
            End With
        End If
    Next rCell

    Set rCell = Nothing
End Sub

Private Sub MergeCells(ByRef lStartRow As Long, ByRef lEndRow As Long, ByRef lColumn As Long)
    With ActiveSheet.Range(Cells(lStartRow, lColumn), Cells(lEndRow, lColumn))
        .VerticalAlignment = xlTop
        .MergeCells = True
    End With
End Sub

flemmingdahl >> Mange tak for hjælpen.

Lige et spm: Hvordan skal koden se ud, hvis man skal finde ens data i en række og derefter gøre det samme som ovenstående?

Brug Data / Sorter først - så er den vist løst

somaliomar>> du mangler lige at acceptere mit svar.

Ups... Sorry :)

helt ok :o)