Anzeige
Archiv - Navigation
1524to1528
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

ListView mit Bedingung einlesen

ListView mit Bedingung einlesen
23.11.2016 14:00:21
Ludmila
Hallo Spezialisten,
Wenn ich eine ListView nach Textbox1 einlesen möchte,
dann erschein die Fehlermeldung
Indexgrenze überschritten, Laufzeitfehler 35600
Private Sub Suchen_Click()
With ListView1
.ListItems.Clear
.ColumnHeaders.Clear
.Refresh
Rem Überschriften
.ColumnHeaders.Add 1, , "Name", 100
.ColumnHeaders.Add 2, , "Vorname", 100
.ColumnHeaders.Add 3, , "Strasse", 100
.ColumnHeaders.Add 4, , "ID", 25
Rem Daten einlesen
.FullRowSelect = True
.View = 3
.Gridlines = True
n = 2
For ii = 1 To Cells(Rows.Count, 1).End(xlUp).Row - 1
If Cells(ii, 5) = TextBox1.Value Then
n = ii
.ListItems.Add , , Cells(n, 1).Value
.ListItems(ii).SubItems(1) = Cells(n, 2).Value
.ListItems(ii).SubItems(2) = Cells(n, 3).Value
.ListItems(ii).SubItems(3) = Cells(n, 4).Value
n = n + 1
End If
Next ii
.ListItems.Remove (1)
.HideSelection = False
End With
End Sub
Danke, für Eure Hilfe
Gruß
Ludmila

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ListView mit Bedingung einlesen
23.11.2016 20:14:00
GraFri
Hallo
Versuchs mal so. Hab aber Zellbezüge geändert, da ich eine Tabelle von mir benutzt habe.
Private Sub UserForm_Initialize()
With ListView1
' Überschriften
.ColumnHeaders.Add 1, , "Name", 100
.ColumnHeaders.Add 2, , "Vorname", 100
.ColumnHeaders.Add 3, , "Strasse", 100
.ColumnHeaders.Add 4, , "ID", 25
' Eigenschaften des ListView
.FullRowSelect = True
.View = 3
.Gridlines = True
.HideSelection = False
End With
End Sub
Private Sub Suchen_Click()
Dim letzteZeile  As Integer
Dim n As Integer
Dim ii As Integer
letzteZeile = Cells(Rows.Count, 1).End(xlUp).Row
With ListView1
.ListItems.Clear
' Daten einlesen
n = 1
For ii = 1 To letzteZeile - 1
If CStr(Cells(ii, 3).Value) = TextBox1.Value Then
.ListItems.Add , , Cells(ii, 1).Value
.ListItems(n).SubItems(1) = Cells(ii, 2).Value
.ListItems(n).SubItems(2) = Cells(ii, 3).Value
.ListItems(n).SubItems(3) = Cells(ii, 4).Value
n = n + 1
End If
Next ii
' .ListItems.Remove (1)  ' löscht die erste Zeile. Warum ?
End With
End Sub

mfg, GraFri
Anzeige
AW: ListView mit Bedingung einlesen
24.11.2016 07:43:53
GraFri
Hallo
Noch eine Lösung.
Es ist besser und wesentlich schneller, wenn man die Daten in einem Rutsch aus der Tabelle in ein Array einliest und mit diesem Array dann weiterarbeitet.
Option Explicit
Dim xDaten() As Variant ' Array für die gesamten Daten
Dim letzteZeile As Integer
Private Sub UserForm_Initialize()
With ListView1
' Überschriften
.ColumnHeaders.Add 1, , "Name", 100
.ColumnHeaders.Add 2, , "Vorname", 100
.ColumnHeaders.Add 3, , "Strasse", 100
.ColumnHeaders.Add 4, , "ID", 25
' Eigenschaften des ListView
.FullRowSelect = True
.View = 3
.Gridlines = True
.HideSelection = False
End With
' Letztze Datenzeile aus Tabelle 'Kassabuch'
letzteZeile = Cells(Rows.Count, 1).End(xlUp).Row
' Array dimensionieren
ReDim xDaten(1 To letzteZeile, 1 To 4)
' Daten in Array einlesen
xDaten = Worksheets("Kassabuch").Range(Cells(1, 1), Cells(letzteZeile, 4)).Value
End Sub
Private Sub Suchen_Click()
Dim n As Integer
Dim ii As Integer
With ListView1
.ListItems.Clear
' Daten in Listview eintragen
n = 1
For ii = 1 To UBound(xDaten)
If CStr(xDaten(ii, 3)) = TextBox1.Value Then
.ListItems.Add , , xDaten(ii, 1)
.ListItems(n).SubItems(1) = xDaten(ii, 2)
.ListItems(n).SubItems(2) = xDaten(ii, 3)
.ListItems(n).SubItems(3) = xDaten(ii, 4)
n = n + 1
End If
Next ii
' .ListItems.Remove (1)  ' löscht die erste Zeile. Warum ?
End With
End Sub

mfg, GraFri
Anzeige
AW: ListView mit Bedingung einlesen
24.11.2016 08:39:36
Ludmila
Hallo GraFri,
vielen Dank, dass Du Dir solche Mühe machst.
Bei mir sind die Daten nicht exakt in der Spalten Reihenfolge
Ich lese die Daten wie folgt ein:
Private Sub KD_lst_einlesen()
Set WkbD = Workbooks(sD)
Set WksKD = WkbD.Worksheets(KD)
With UFKD.ListView1
.ListItems.Clear
.ColumnHeaders.Clear
.View = 3
.Gridlines = True
.FullRowSelect = True
.AllowColumnReorder = False
.ColumnHeaders.Add , , "KDNR", 40
.ColumnHeaders.Add , , "ANREDE", 40
.ColumnHeaders.Add , , "NACHNAME", 80
.ColumnHeaders.Add , , "VORNAME", 80
.ColumnHeaders.Add , , "STRASSE", 120
.ColumnHeaders.Add , , "PLZ ORT", 120
.ColumnHeaders.Add , , "MOBIL", 80
.ColumnHeaders.Add , , "TELEFON1", 80
.ColumnHeaders.Add , , "MAIL", 80
.ColumnHeaders.Add , , "ID", 0
If IsEmpty(WksKD.Cells(2, 1)) Then: Exit Sub
For ii = 1 To WksKD.Cells(Rows.Count, 1).End(xlUp).Row
lSp = WksKD.Rows(1).Find(what:="KDNR", LookIn:=xlValues, lookat:=xlWhole).Column: . _
ListItems.Add , , WksKD.Cells(ii, lSp)
lSp = WksKD.Rows(1).Find(what:="ANREDE", LookIn:=xlValues, lookat:=xlWhole).Column: . _
ListItems(ii).SubItems(1) = WksKD.Cells(ii, lSp)
lSp = WksKD.Rows(1).Find(what:="NACHNAME", LookIn:=xlValues, lookat:=xlWhole).Column: . _
ListItems(ii).SubItems(2) = WksKD.Cells(ii, lSp)
lSp = WksKD.Rows(1).Find(what:="VORNAME", LookIn:=xlValues, lookat:=xlWhole).Column: . _
ListItems(ii).SubItems(3) = WksKD.Cells(ii, lSp)
lSp1 = WksKD.Rows(1).Find(what:="HSNR", LookIn:=xlValues, lookat:=xlWhole).Column
lSp = WksKD.Rows(1).Find(what:="STRASSE", LookIn:=xlValues, lookat:=xlWhole).Column: . _
ListItems(ii).SubItems(4) = WksKD.Cells(ii, lSp) & " " & WksKD.Cells(ii, lSp1)
lSp1 = WksKD.Rows(1).Find(what:="ORT", LookIn:=xlValues, lookat:=xlWhole).Column
lSp = WksKD.Rows(1).Find(what:="PLZ", LookIn:=xlValues, lookat:=xlWhole).Column: . _
ListItems(ii).SubItems(5) = WksKD.Cells(ii, lSp) & " " & WksKD.Cells(ii, lSp1)
lSp = WksKD.Rows(1).Find(what:="MOBIL", LookIn:=xlValues, lookat:=xlWhole).Column: . _
ListItems(ii).SubItems(6) = WksKD.Cells(ii, lSp)
lSp = WksKD.Rows(1).Find(what:="TELEFON1", LookIn:=xlValues, lookat:=xlWhole).Column: . _
ListItems(ii).SubItems(7) = WksKD.Cells(ii, lSp)
lSp = WksKD.Rows(1).Find(what:="MAIL", LookIn:=xlValues, lookat:=xlWhole).Column: . _
ListItems(ii).SubItems(8) = WksKD.Cells(ii, lSp)
lSp = WksKD.Rows(1).Find(what:="ID", LookIn:=xlValues, lookat:=xlWhole).Column: . _
ListItems(ii).SubItems(9) = WksKD.Cells(ii, lSp)
Next ii
.HideSelection = False
.ListItems.Remove (1)
If .ListItems.Count = 1 Then
UFKD.lblKDAnzahl.Caption = "Doppelklick öffnet Bearbeitung - Gesamt:" & " " & .ListItems. _
Count & " Kunde"
Else
UFKD.lblKDAnzahl.Caption = "Doppelklick öffnet Bearbeitung - Gesamt:" & " " & .ListItems. _
Count & " Kunden"
End If
End With
End Sub
Jetzt ist auch Deine Frage zu .ListItems.Remove (1) beantwortet.
Gruß
Ludmila
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige