Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Probleme mit VBA- Code





Frage

Hallo zusammen, ich habe folgenden Code zur suche von bestimmten Daten in einer Excel- Tabelle. Dieser Code gibt mir aber, wenn mehrere gleichen Daten untereinander stehen nur jede zweite wieder. Ich habe schon stundenlang gesucht, kann den fehler aber nicht finden. Kann mir jemand von euch helfen??? Private Sub optXXX_Click() Dim zaehler1 As Long Dim letzte As Long Dim suche1 As Range Dim wert As Variant With Worksheets(2) '' Tabellenblatt 1 Löschen Sheets("Suchergebnis").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select Sheets("Liste1").Select wert = "XXX" For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row Set suche1 = Worksheets(1).Range("C" & zaehler1 & ":C" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Find(wert) If Not suche1 Is Nothing Then Sheets(1).Rows(suche1.Row).Copy letzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Row .Rows(letzte & ":" & letzte).Insert Shift:=xlDown Sheets(1).Application.CutCopyMode = False zaehler1 = suche1.Row End If Next zaehler1 End With Sheets("Suchergebnis").Select Rows("1:1").Select Application.CutCopyMode = False Selection.Insert Shift:=xlDown Range("A1:W1").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge With Selection.Font .Name = "Arial" .Size = 16 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Rows("1:1").Select Selection.RowHeight = 30 With Selection .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext End With ActiveCell.FormulaR1C1 = "Ergebnis der Suche" Selection.Font.Bold = True Range("A2").Select Sheets("Liste1").Select Rows("2").Select Selection.Copy Sheets("Suchergebnis").Select Rows("2:2").Select Selection.Insert Shift:=xlDown Columns("A:W").Select Range("A2").Activate Selection.Columns.AutoFit Range("A4:W1000").Select Selection.Sort Key1:=Range("o3"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortTextAsNumbers Range("A1:W1").Select Application.CutCopyMode = False Hide End Sub MfG Axel

Antwort von



Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: