Supportnet / Forum / Tabellenkalkulation

hallo, ich habe eine datenbank, in der ich jede 2. und 3. zeile löschen möchte. das ergebniss soll anschließend sortiert und die doppelten einträge gelöscht werden. es das möglich? danke karlheinz

Hallo karlheinz,

bevor ich Dir helfen kann, solltest Du bitte nochmal etwas ausführlicher schildern, was Du genau machen willst.
Was bedeutet: "ich habe eine Datenbank"
Hast Du ein Excel Arbeitsblatt, einen File mit vielen Arbeitsblättern oder etwas ganz anderes?

Gruß
Günter

zu Teil 2 deiner Frage:
Daten- Filter - Spezialfilter - an eine andere stelle kopieren - keine Dublikate.

Für deine erste Frage gibt es bestimmt einen Klasse-Tipp von den VBA-Experten (da gehöre ich leider nicht dazu :-( ).

GGF. kann man das aber mit einem Filter oder über einen kleinen Umweg lösen.
Ist es jeweils immer nur die 2. und 3. Zeile oder gelten für die Datensätze nicht auch irgendwelche Bedingungen, nach denen gelöscht wird oder was übrig bleiben soll?
Man könnte es z.B. mit einer Hilfsspalte lösen, in der du über Autoausfüllen z.b. immer fortlaufend 1,2,3 einträgst und dann per Filter nur die Zeilen mit der 1 filterst. Die mit dem Wert 2 oder 3 könntest du dann löschen.
Ich nicht so elegant wie mit VBA, klappt aber auch ;-)

HTH+CU
Klaus

Du kannst uns mal erzählen, welche Datenbank Du benutzt. Wenn es eine SQL-Datenbank ist, dann sollte eine (einfache) Anweisung reichen, um die Daten zu ändern.

Gruß

Rainer

Hallo,
die Datenbank ist eine importierte *.txt-Datei in der Fragen und Antworten stehen. Um doppelte Fragen zu vermeiden sollen nur die Antworten übrig bleiben, die ich anschließend sortieren und anschließend die doppelten Fragen löschen kann. Zwischen jeder Frage und Antwort ist eine Leerzeile. Die Filterfunktion habe ich schon ausprobiert, ist aber nicht unbedingdas, was ich mir vorgestellt habe. Ich dachte mehr an ein Makro oder soetwas. Ich hoffe, Ihr wisst nun genau, was ich meine.
Gruß
Karlheinz

Hi Karlheinz,

alle VBA-ler möchten die Augen schließen und sich hoffentlich schnellstens von ihrem Lachanfall erholen. Aber nachdem ich von VB-Programmierung absolut keine Ahnung habe, habe ich halt ein Makro aufgezeichnet, das zumindest bei mir zum Erfolg geführt hat.
Voraussetzungen: Die Texte stehen in Spalte A, beginnend in A1,

also A1 Frage
A2 leer
A3 Antwort
A4 Frage
A5 leer usw...

Sub Makro2()

Range("B2").Select
ActiveCell.FormulaR1C1 = "=IF(OR(R[-1]C[-1]="""",RC[-1]=""""),1,0)"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B1000"), Type:=xlFillDefault
Range("B2:B1000").Select
Range("B1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="1"
Rows("2:1000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=2
Selection.AutoFilter
Columns("B:B").Select
Selection.ClearContents
Columns("A:A").Select
Application.CutCopyMode = False
Range("A1:A1000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"B1:B1000"), Unique:=True
Columns("B:B").Select
Selection.Copy
Columns("A:A").Select
ActiveSheet.Paste
Columns("B:B").Select
Application.CutCopyMode = False
Selection.ClearContents
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Überschrift"
Range("A1").Select
Range("A1:A1000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"B1:B1000"), Unique:=True
Columns("B:B").Select
Selection.Copy
Columns("A:A").Select
ActiveSheet.Paste
Columns("B:B").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
End Sub

CU Aliba

wahrscheinlich denke ich zu kompliziert:
wenn es lediglich darum geht, Leerzeilen zu löschen, klappt das bei mir ganz einfach wie folgt:
den entsprechenden Tabellenbereich markieren, aufsteigend sortieren.

Dann sind die Zeilen mit Inhalt oben, die Leerzeilen sind dann unten.

Wozu brauche ich dafür dann noch ein Makro???
So ganz versteh ich immer noch nicht, wie die Tabelle konkret aussieht. Im ersten Posting hiess es "jede 2. und 3. Zeile löschen".
Danach heisst es "zwischen Frage und Antwort befindet sich jeweils eine Leerzeile".
M.E. widerspricht sich das.

Wie wäre es mal mit ein wenig Klartext?

CU
Klaus

Hi Klaus,

ich hab das so verstanden:

A1: Frage 1
A2: leer
A3: Antwort 1
A4: Frage 2
A5: leer
A6: Antwort 2
A7: Frage 3
....

Etwas unverständlich war für mich, daß am Ende nur die Antworten übrig bleiben sollen, wenn jede 2. und 3. Zeile gelöscht wird. Das würde nach der ursprünglichen Beschreibund nicht passen. Ich bin davon ausgegangen, daß die Fragen übrig bleiben sollen, sortiert werden sollen und dann die doppelten Fragen gelöscht werden sollen.

CU Aliba

@Aliba: Karlheinz sollte sich zweckmäßigerweise mal äußern, wie die Tabelle genau aussieht und was er für ein ERgebnis erreichen will.
Mach ich nen Denkfehler, oder ist das mit dem Entfernen der Leerzeilen wirklich so kompliziert? <beimirklapptssowieichobenbeschriebenhabe>

CU
KLaus

Hi Klaus,

es sollen nicht nur die Leerzellen, sonder auch jeweils die einer Leerzelle
nachfolgende Zeile gelöscht werden.

CU Aliba

Hallo @all:

ich poste hier mal die E-Mail, die mir Karl-Heinz geschickt hat, damit der Thread auch im SN gelöst werden kann.

"Hallo,
ich kann keine Antwort mehr im Forum eingeben, warum weiß ich nicht. Deshalb wende ich mich an dich per eMail.
Excel soll per Userform eine Auswahl von *.txt-Dateien aus einem Ordner vorschlagen, in der die 2. und 3. Zeile glöscht werden, so daß nur die Fragen sichtbar sind. Diese fragen sollen anschließend sortiert werden um doppelte Einträge zu finden. Das ist alles. Vielleicht kann man auch die doppelten Einträge gleich farbig markieren oder ähnliches.
Aufbau der Datenbank:
1. Zeile FRAGE
2. Zeile ANTWORT
3. Zeile leer bzw. Kommentar
4. Zeile FRAGE
5. Zeile ANTWORT
6. Zeile leer bzw. Kommentar
usw. usw.
bis jetzt sind es ca. 6000 Fragen"

Ich denke, das müßte am besten mit VBA zu lösen sein(kann ich aber nicht, dafür gibt es doch hier genug Experten,oder?)

Ich würde es notgedrungen über eine Hilfsapalte lösen, die ich jeweils fortlaufend mit 1,2,3 füllen würde. Dann nur die Zeilen mit der 1 filtern und kopiere (ohn Dublikate).
Ist bestimmt nicht elegant, klappt aber auch ;-)

So, und jetzt die VBA-Experten mit einer akademischen Lösung.

CU
Klaus

Hallo Karlheinz,

Ich seh mal von der etwas verwirrenden Formulierung "per Userform eine Auswahl von *.txt-Dateien aus einem Ordner vorschlagen, in der die 2. und 3. Zeile glöscht werden" ab und nehme an, daß die in Excel importierten und in einer Tabelle stehenden Daten zu löschen/sortieren sind.
Weiter geh ich davon aus, daß Dir, Karlheinz, VBA geläufig ist, sonst hättest Du keine User-Form basteln können.

Drum hier nur das Makro zum einbaun in Deine Tabelle -> Doppelte werden gelöscht, wie ursprünglich gewünscht. -> Fragen in Spalte A.

Sub Kalmi()
Dim x%, y$
   For x = 2 To ActiveSheet.UsedRange.Rows.Count
      Rows(x).Range("A1:A2").EntireRow.Delete
   Next
x = Cells(Rows.Count, 1).End(xlUp).Row
y = Mid(Cells(1, ActiveSheet.UsedRange.Columns.Count).Address, 2, 1)
Range("A1:" & y & x).Sort Key1:=Range("A1"), Order1:=xlAscending, _
      Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
   For x = x To 2 Step -1
      If Cells(x, 1) = Cells(x - 1, 1) Then
         Rows(x).EntireRow.Delete
      End If
   Next
End Sub

Gruß
sicci

@Klaus: akademisch genug ? :-)

@sicci
Denke ich jetzt in der falschen Richtung oder ist es wirklich so, daß Du mit
For x = 2 To ActiveSheet.UsedRange.Rows.Count
Rows(x).Range("A1:A2").EntireRow.Delete Next
ALLE Zeilen löschst ??
Verändert sich eigentlich der Index der Zeile, wenn Zeilen gelöscht werden ?
Ich würde das mit Steinzeitmethode lösen:
Erst mal in einer zusätzlichen Zelle von 1 bis 3 zählen und dann die Zeilen mit Zelle = 2 oder 3 löschen.
Dim lastrow As Integer
dim z as integer
dim x as integer
With Range("A1")
lastrow = .SpecialCells(xlCellTypeLastCell).Row
End With
z = 0
for x = 1 to lastrow
z = z + 1
if z > 3 then z = 1
cells(x,10) = z
next x
For x = 1 To lastrow
if cells(x,10) = 2 or cells(x,10) = 3 then
Rows(x).Range("A1:A2").EntireRow.Delete
end if
Next x

oder so ähnlich
Gruß
Teddy

@sicci:für mich auf jeden Fall!
Ich kann doch nur dann ein wenig mithalten, wenn es sich um Formeln handelt oder wenn ich was Fertiges aus Büchern abschreiben kann ;-)

Aber ich lese immer wieder sehr gerne die individuellen VBA-LÖsungen und Tipps hier im SN und hoffe, dass ich es auch irgendwannmal auf die Reihe kriege.

CU
KLaus

Hallo Teddy,

mit
Rows(x).Range("A1:A2").EntireRow.Delete
wird Zeile x + Zeile x+1 gelöscht.

ist x zB 2 (die erste Antwort), wird Zeile 2und3 gelöscht. Dadurch 'rutscht' Zeile 4(die nächste Frage) auf Zeile 2 und wird (next x ist 3) nicht mehr abgefragt und nicht mehr gelöscht. :-).
Damit beantwortet sich auch Deine Frage, ob der Index der Zeile sich ändert.

Gruß
sicci

Raffinierte Lösung !!!
Wieder was gelernt.
Danke !
Teddy

Hallo Akademiker,
Es könnte sein das der karlheinz eine Dateiauswahl benötigt:

Und da hab ich mir gedacht, man könnte es auch so lösen:

set exc = createObject("Excel.Application")
set fso = createObject("Scripting.FileSystemObject")
set ie = CreateObject("InternetExplorer.Application")
ie.visible = false
ie.navigate "about:<html><body><form><INPUT type=file name=file1></form></body></html>"
do
loop while ie.ReadyState<>4
ie.document.forms(0).elements.item("file1").click
set Datei = fso.openTextfile(ie.document.forms(0).elements.item("file1").value)
x=1
exc.Visible = true
exc.WorkBooks.Add

do until Datei.atEndOfstream
  exc.Cells(x, 1).Value = Datei.Readline
  if Datei.atEndofline = false then Datei.skipline
  if Datei.atEndofline = false then Datei.skipline
x=x+1
loop

with exc.Worksheets("Tabelle1")
.Activate
.Range("A1:B" & x-1 ).Sort .Range("A1"),1,0,,,,,,,,1
end with
for y=1 to x-2
if exc.Cells(y,1).Value = exc.Cells(y+1,1).Value then exc.Rows(y+1).EntireRow.Delete
next
Datei.close 
ie.quit
set ie = Nothing
set fso = Nothing

Da muß der karlheinz jetzt ein VBS draus machen. Jetzt braucht er die Datei nicht erst in Excel importieren..etc, sondern kann sie einfach per Dateiauswahl aufrufen. Und schwups ist sie in Excel umgewandelt.
Das mit dem Löschen der doppelten Datensätze hab ich mal einfach von sicci übernommen. Es könnte aber sein, daß der karlheinz die garnicht löschen möchte? Dann sollte man die Zellen einfach einfärben. Geht ja auch....
Gruß struppi

o sorry,
Jetzt muß struppisoft schon das erste update schicken. Die Löschschleife muß ala sicci so lauten:

for x = x-1 to 2 step -1
if exc.Cells(x,1).Value = exc.Cells(x-1,1).Value then exc.Rows(x-1).EntireRow.Delete
next

gruß struppi

Hallo,
Heute Morgen war keine Zeit, da mußte Struppisoft leider ne Codezeile der "Kongurenz" ;-) benutzen.
Das wird jetzt geändert!
Hier kommt noch was akadämliches von Struppi:

set exc = createObject("Excel.Application")
set fso = createObject("Scripting.FileSystemObject")
set ie = CreateObject("InternetExplorer.Application")
ie.visible = false
ie.navigate "about:<html><body><form><INPUT type=file name=file1></form></body></html>"
do
loop while ie.ReadyState<>4
ie.document.forms(0).elements.item("file1").click
set Datei = fso.openTextfile(ie.document.forms(0).elements.item("file1").value)
x=1
l=0
exc.Visible = true
exc.WorkBooks.Add

do until Datei.atEndOfstream
  exc.Cells(x, 1).Value = Datei.Readline : if len(exc.Cells(x, 1).Value) > l then l=len(exc.Cells(x, 1).Value)
  if Datei.atEndofline = false then Datei.skipline
  if Datei.atEndofline = false then Datei.skipline
x=x+1
loop

with exc.Worksheets("Tabelle1")
.Activate
.Range("A1:B" & x-1 ).Sort .Range("A1"),1,0,,,,,,,,1
end with
for y = 1 to x-2
if exc.Cells(y,1).Value = exc.Cells(y+1,1).Value then
 exc.Cells(y,1).Interior.ColorIndex = 45
 exc.Cells(y+1,1).Interior.ColorIndex = 45
end if
exc.Columns("A:A").ColumnWidth = l
next
Datei.close 
ie.quit
set ie = Nothing
set fso = Nothing
set Datei = Nothing

gruß struppi

• Zeilen mit #BEZUG# löschen
• Daten ergänzen und löschen
• Möchte im Excel wiederholend jede 2-9 Zeile löschen
• Excel Zeilen löschen
• Scanner - was ist eine Zeile ?