Sub KopierenOhneDoppelte

Bild

Betrifft: Sub KopierenOhneDoppelte
von: Sascha
Geschrieben am: 26.11.2003 23:13:48

Hallo Freunde!!
Mit folgendem Code :


Sub KopierenOhneDoppelte()
   Dim wks As Worksheet
   Dim iRow As Integer, iCol As Integer, iRowT As Integer
   Set wks = Worksheets("Tabelle2")
   iRow = 1
   iCol = 1
   wks.Columns("A").ClearContents
   Do Until IsEmpty(Cells(iRow, iCol))
      Do Until IsEmpty(Cells(iRow, iCol))
         If WorksheetFunction.CountIf( _
            wks.Columns(1), Cells(iRow, iCol).Value) = 0 Then
            iRowT = iRowT + 1
            wks.Cells(iRowT, 1).Value = Cells(iRow, iCol).Value
         End If
         iCol = iCol + 1
      Loop
      iRow = iRow + 1
      iCol = 1
   Loop
End Sub


Versuche ich werte aus Tabelle1 zu Tabelle2 zu kopieren. Es funktioniert super wenn alle Zellen in Tabelle1 Spalte A voll sind. Wenn Z.b.A14 leer ist dann wird nur bis A14 kopiert.
Es sollten alle lehre Zellen genau so wie doppelte eintrage entfallen und auch werte nach eine lehre Zelle kopiert seien.
Wer hilft weiter????
Danke
Gruß Sascha...
Bild


Betrifft: AW: Sub KopierenOhneDoppelte
von: PeterW
Geschrieben am: 27.11.2003 00:02:14

Hallo Sascha,

sofern es sich nur um Werte aus Spalte A handelt könnte es so gehen:

Sub KopierenOhneDoppelte()
   Dim wks As Worksheet
   Dim iRow As Integer, iRowT As Integer
   Set wks = Worksheets("Tabelle2")
   wks.Columns("A").ClearContents
   iRowT = 1
   For iRow = 1 To Range("A65536").End(xlUp).Row
      If Cells(iRow, 1) <> "" Then
         If WorksheetFunction.CountIf(wks.Columns(1), _
         Cells(iRow, 1)) = 0 Then
            iRowT = iRowT + 1
            wks.Cells(iRowT, 1) = Cells(iRow, 1)
         End If
      End If
    Next
End Sub

Sollten die Werte aller Spalten kopiert werden müsste klar sein, ob die Zeilen wirklich alle auseinander gerissen werden sollen und die Werte aller Datensätze untereinander in der Spalte A erscheinen sollen.

Gruß
Peter


Bild


Betrifft: AW: Sub KopierenOhneDoppelte
von: Sascha
Geschrieben am: 27.11.2003 00:07:27

Danke Peter!!!!!!
Jetzt funktioniert.
Gruß Sascha


Bild

Beiträge aus den Excel-Beispielen zum Thema " datei schutzen"