doppelte Einträge anzeigen

14/06/2009 - 07:09 von Holger Nölting | Report spam
Hallo ,

mit folgenden Code suche ich nach Werten in meheren Tabellenblàttern. Leider
werden mir die Werte nicht angezeigt die in einem Blatt doppelt vorkommen.
Kann mir bitte jemand sagen wie ich den Code dementsprechend àndern muß.

Danke + Gruß
Holger

With Worksheets(i).Range("B:B")
Set c = .Find(what:=erg, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Rows
Do
letzteZeile =
Worksheets("Auswertung").Range("A65536").End(xlUp).Row + 1
Worksheets(i).Range("A" & c.Row & ":I" & c.Row).Copy
Worksheets("Auswertung").Range("A" & letzteZeile)
Worksheets(i).Range("A1").Copy
Worksheets("Auswertung").Range("J" & letzteZeile)

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Rows <> firstAddress
End If
End With
Next i
 

Lesen sie die antworten

#1 Andreas Killer
14/06/2009 - 08:10 | Warnen spam
Holger Nölting schrieb:

mit folgenden Code suche ich nach Werten in meheren Tabellenblàttern. Leider
werden mir die Werte nicht angezeigt die in einem Blatt doppelt vorkommen.


2 Anmerkungen:

a.) Dein Code sucht nicht nach doppelten Eintràgen, er sucht nur nach
Inhalt-"erg" und gibt alle Ergebnisse aus, auch wenn sie nur einmal da
sind.

b.) Es wàre nett wenn Du das nàchste Mal den gesamten Code oder eine
lauffàhige Sub posten würdest, dann muss man sich nicht was
zurechtbasteln.

With Worksheets(i).Range("B:B")
Set c = .Find(what:=erg, LookIn:=xlValues)


Hast Du hier LookAt bewusst weggelassen? Das solltest Du nicht, denn
Find ist identisch mit dem Suchen in der Oberflàche, d.h. suchst Du
dort mit der Option "ganze Zellen" dann ist das wie wenn Du LookAt:=
xlWhole sagst, ansonsten LookAt:= xlPart und Dein Code würde
unterschiedliche Ergebnisse bringen.

If Not c Is Nothing Then
firstAddress = c.Rows


c.Rows ist falsch, denn Rows gibt ein Range-Object zurück, das
eigentlich alle Zeilen des aktiven Arbeitsblattes darstellt. Nur
beziehst Du Dich hier auf nur eine Zelle, was bedeutet das C.Rows = C ist.

Wenn Du nur einmal die Zeile haben willst, dann muss es C.Row heißen,
was die Zeilennummer zurückgibt. Merke: VBA-Bezeichner mit 'nem s
hinten dran beziehen sich immer auf alle! (Column/Columns,
Sheet/Sheets, Workbook/Workbooks, etc.)

Ausnahmsweise funktioniert übrigens Dein Vorgehen hier, weil Du Dich
nur auf Spalte B beziehst. Falls Du in mehreren Spalten suchen
möchtest, dann braucht es noch die Suchrichtung
SearchOrder:=xlByColumns damit es zuerst nach rechts sucht, sonst
würde die Identifizierung über C.Row nicht gehen.

Do
letzteZeile =
Worksheets("Auswertung").Range("A65536").End(xlUp).Row + 1


Range("A65536") ist nicht geschickt, Range("A" & Rows.Count) macht das
gleiche, geht dann aber auch für den Fall das Du mal Bereiche
innerhalb eines Blattes durchsuchen möchtest.

Außerdem ist die Zeile falsch platziert, Das brauchst Du nur einmal zu
ermitteln, danach kannst Du die letzte Zeile einfach um eins erhöhen.

Worksheets(i).Range("A" & c.Row & ":I" & c.Row).Copy
Worksheets("Auswertung").Range("A" & letzteZeile)
Worksheets(i).Range("A1").Copy
Worksheets("Auswertung").Range("J" & letzteZeile)

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Rows <> firstAddress


Hier noch mals C.Rows

End If
End With
Next i


Next i gehört nicht zum Code.

Eine lauffàhige Version ist unten dran.

Andreas.

Sub test()
erg = "b"
i = 1
With Worksheets("Auswertung")
letzteZeile = .Range("A" & .Rows.Count).End(xlUp).Row
'Erste Zeile leer?
If Not IsEmpty(.Cells(letzteZeile, 1)) Then _
letzteZeile = letzteZeile + 1
'Letzte Zeile voll?
If letzteZeile > .Rows.Count Then
'Fehlermeldung
Exit Sub
End If
End With
With Worksheets(i).Range("B:B")
Set c = .Find(what:=erg, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Row
Do
Worksheets(i).Range("A" & c.Row & ":I" & c.Row).Copy _
Worksheets("Auswertung").Range("A" & letzteZeile)
Worksheets(i).Range("A1").Copy _
Worksheets("Auswertung").Range("J" & letzteZeile)
letzteZeile = letzteZeile + 1
'Letzte Zeile voll?
If letzteZeile > Worksheets("Auswertung").Rows.Count Then
'Fehlermeldung
Exit Sub
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Row <> firstAddress
End If
End With
End Sub

Ähnliche fragen