Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1360to1364
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

Makro Fehler drin...

Makro Fehler drin...
10.05.2014 19:17:40
walter
Hallo zusammen,
habe folgendes Makro im Forum bzw. Google gefunden. Es klappt soweit
für das Suchen in der Listbox.
Leider kommt bleibt das Makro bei der Zeile stehen:
' Me.ListBox1.List(iLiBo, 10) = Format(WkSh.Range("K" & rZelle.Row).Value, "YY")
die anderen Daten werden eingelesen.
Habe also die Zeilen von K bis AL ausgeklammert.
Wo ist da der Fehler, habe Textbox1 und 2 für das Suchen.
Textbox für Spalte 3 "Firmennamen" und Textbox 2 für das Suchen "Namen".
Im Makro waren vorher 3 Textboxen vorgesehen, hatte soweit Textmäßig gelöscht.
Vielleicht hat jemand eine IDEEEEEE, ich leider nicht, fummel jetzt schon
4h darum...
mfg Walter
Private Sub CommandButton14_Click()
Dim WkSh          As Worksheet
Dim rZelle        As Range
Dim sFundst       As String
Dim sSuchbegriff  As String
Dim iSpalte       As Integer
Dim iLiBo         As Integer
Dim lZeile        As Long
Dim lLetzte       As Long
Dim sTyp          As String
Me.ListBox1.RowSource = ""
'Exit Sub
TextBox1.Value = Trim$(TextBox1.Value)
TextBox2.Value = Trim$(TextBox2.Value)
If TextBox1.Value = "" And _
TextBox2.Value = "" Then
MsgBox "Ohne Suchbegiff wird die Suche schwierig werden!" & Chr(10) & _
"Bitte geben Sie wenigstens einen Suchbegriff ein - danke.", _
48, "   Hinweis für " & Application.UserName
TextBox1.SetFocus
Exit Sub
ElseIf TextBox1.Value  "" Then
sSuchbegriff = TextBox1.Value & "*"
iSpalte = 3
ElseIf TextBox2.Value  "" Then
sSuchbegriff = TextBox2.Value
iSpalte = 8
End If
Set WkSh = ThisWorkbook.Worksheets("Datenbank")
With WkSh.Columns(iSpalte)
' Set rZelle = .Find(What:=sSuchbegriff, LookAt:=xlPart, LookIn:=xlValues, _
After:=.Cells(.Cells.Count))
'--- hiermit wird nur nach dem 1. Buchstaben gesucht ---
Set rZelle = .Find(What:=sSuchbegriff, LookAt:=xlWhole, LookIn:=xlValues, _
After:=.Cells(.Cells.Count))
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
If iSpalte = 1 Then
If TextBox1.Value  "" Then
If InStr(LCase(WkSh.Range("A" & rZelle.Row)), LCase(TextBox1.Value)) > 0 Then
GoSub ListBox_fuellen
End If
Else
GoSub ListBox_fuellen
End If
Else
GoSub ListBox_fuellen
End If
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address  sFundst
Else
If iSpalte = 3 And TextBox1.Value  "" Then
MsgBox "Zu den Begriffen  """ & sSuchbegriff & " / " & TextBox1.Value & _
"""  wurde nichts gefunden.", _
48, "   Hinweis für " & Application.UserName
TextBox1.SetFocus
Else
MsgBox "Der Begriff  """ & sSuchbegriff & """  wurde nicht gefunden.", _
48, "   Hinweis für " & Application.UserName
If iSpalte = 8 And TextBox2.Value  "" Then
MsgBox "Zu den Begriffen  """ & sSuchbegriff & " / " & TextBox2.Value & _
"""  wurde nichts gefunden.", _
48, "   Hinweis für " & Application.UserName
TextBox2.SetFocus
Else
' MsgBox "Der Begriff  """ & sSuchbegriff & """  wurde nicht gefunden.", _
48, "   Hinweis für " & Application.UserName
End If
End If
End If
End With
Set rZelle = Nothing
Exit Sub
ListBox_fuellen:
Me.ListBox1.AddItem " "
Me.ListBox1.List(iLiBo, 0) = WkSh.Range("A" & rZelle.Row).Value
Me.ListBox1.List(iLiBo, 1) = WkSh.Range("B" & rZelle.Row).Value
Me.ListBox1.List(iLiBo, 2) = WkSh.Range("C" & rZelle.Row).Value
Me.ListBox1.List(iLiBo, 3) = WkSh.Range("D" & rZelle.Row).Value
Me.ListBox1.List(iLiBo, 4) = WkSh.Range("E" & rZelle.Row).Value
Me.ListBox1.List(iLiBo, 5) = WkSh.Range("F" & rZelle.Row).Value
Me.ListBox1.List(iLiBo, 6) = WkSh.Range("G" & rZelle.Row).Value
Me.ListBox1.List(iLiBo, 7) = WkSh.Range("H" & rZelle.Row).Value
Me.ListBox1.List(iLiBo, 8) = WkSh.Range("I" & rZelle.Row).Value
Me.ListBox1.List(iLiBo, 9) = Format(WkSh.Range("J" & rZelle.Row).Value, "dd.mm.yyyy")
'  Me.ListBox1.List(iLiBo, 10) = Format(WkSh.Range("K" & rZelle.Row).Value, "YY")
'  Me.ListBox1.List(iLiBo, 11) = WkSh.Range("L" & rZelle.Row).Value
' Me.ListBox1.List(iLiBo, 12) = WkSh.Range("M" & rZelle.Row).Value
' Me.ListBox1.List(iLiBo, 13) = WkSh.Range("N" & rZelle.Row).Value
'  Me.ListBox1.List(iLiBo, 14) = WkSh.Range("O" & rZelle.Row).Value
'  Me.ListBox1.List(iLiBo, 15) = WkSh.Range("P" & rZelle.Row).Value
'   Me.ListBox1.List(iLiBo, 16) = WkSh.Range("Q" & rZelle.Row).Value
'   Me.ListBox1.List(iLiBo, 17) = WkSh.Range("R" & rZelle.Row).Value
'  Me.ListBox1.List(iLiBo, 18) = WkSh.Range("S" & rZelle.Row).Value
'  Me.ListBox1.List(iLiBo, 19) = WkSh.Range("T" & rZelle.Row).Value
'  Me.ListBox1.List(iLiBo, 20) = WkSh.Range("U" & rZelle.Row).Value
'  Me.ListBox1.List(iLiBo, 21) = WkSh.Range("V" & rZelle.Row).Value
'  Me.ListBox1.List(iLiBo, 22) = WkSh.Range("W" & rZelle.Row).Value
'  Me.ListBox1.List(iLiBo, 23) = WkSh.Range("X" & rZelle.Row).Value
' Me.ListBox1.List(iLiBo, 24) = WkSh.Range("Y" & rZelle.Row).Value
iLiBo = iLiBo + 1
Return
Exit Sub
End Sub

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro Fehler drin...
10.05.2014 21:37:01
Peter
Hallo Walter,
mit AddItem kannst Du eine ListBox nur bis max. 10 Spalten befüllen - dann ist Schluss.
das gilt, wie geschrieben, nur bei Zuweisung mittels AddItem. Bei gebundenen Listen ist es nicht auf 10 begrenzt.
Du musst also Deine Werte in ein Array schreiben und dann dieses an die ListBox übergeben.
ListBox1.List = myArray
Gruß Peter

Hallo Peter
10.05.2014 21:46:22
walter
Guten Abend Peter,
und wo muss ich dies reinsetzen und muss ich zusätzlich
was verändern ?
herzlichst
walter mg

AW: Hallo Peter
10.05.2014 22:19:09
Peter
Hallo Walter,
das sollte so funktionieren:
Option Explicit
Private Sub CommandButton14_Click()
Dim WkSh          As Worksheet
Dim rZelle        As Range
Dim sFundst       As String
Dim sSuchbegriff  As String
Dim iSpalte       As Integer
Dim iLiBo         As Integer
Dim lZeile        As Long
Dim lLetzte       As Long
Dim sTyp          As String
Dim vTemp()       As Variant
Dim lTemp         As Long
Me.ListBox1.RowSource = ""
'Exit Sub
TextBox1.Value = Trim$(TextBox1.Value)
TextBox2.Value = Trim$(TextBox2.Value)
If TextBox1.Value = "" And _
TextBox2.Value = "" Then
MsgBox "Ohne Suchbegiff wird die Suche schwierig werden!" & Chr(10) & _
"Bitte geben Sie wenigstens einen Suchbegriff ein - danke.", _
48, "   Hinweis für " & Application.UserName
TextBox1.SetFocus
Exit Sub
ElseIf TextBox1.Value  "" Then
sSuchbegriff = TextBox1.Value & "*"
iSpalte = 3
ElseIf TextBox2.Value  "" Then
sSuchbegriff = TextBox2.Value
iSpalte = 8
End If
Set WkSh = ThisWorkbook.Worksheets("Datenbank")
With WkSh.Columns(iSpalte)
' Set rZelle = .Find(What:=sSuchbegriff, LookAt:=xlPart, LookIn:=xlValues, _
After:=.Cells(.Cells.Count))
'--- hiermit wird nur nach dem 1. Buchstaben gesucht ---
Set rZelle = .Find(What:=sSuchbegriff, LookAt:=xlWhole, LookIn:=xlValues, _
After:=.Cells(.Cells.Count))
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
If iSpalte = 1 Then
If TextBox1.Value  "" Then
If InStr(LCase(WkSh.Range("A" & rZelle.Row)), LCase(TextBox1.Value)) > 0 Then
GoSub ListBox_fuellen
End If
Else
GoSub ListBox_fuellen
End If
Else
GoSub ListBox_fuellen
End If
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address  sFundst
Else
If iSpalte = 3 And TextBox1.Value  "" Then
MsgBox "Zu den Begriffen  """ & sSuchbegriff & " / " & TextBox1.Value & _
"""  wurde nichts gefunden.", _
48, "   Hinweis für " & Application.UserName
TextBox1.SetFocus
Else
MsgBox "Der Begriff  """ & sSuchbegriff & """  wurde nicht gefunden.", _
48, "   Hinweis für " & Application.UserName
If iSpalte = 8 And TextBox2.Value  "" Then
MsgBox "Zu den Begriffen  """ & sSuchbegriff & " / " & TextBox2.Value & _
"""  wurde nichts gefunden.", _
48, "   Hinweis für " & Application.UserName
TextBox2.SetFocus
Else
' MsgBox "Der Begriff  """ & sSuchbegriff & """  wurde nicht gefunden.", _
48, "   Hinweis für " & Application.UserName
End If
End If
End If
End With
Set rZelle = Nothing
If lTemp > 0 Then
ListBox1.List = Application.Transpose(vTemp)
Else
MsgBox "Es konnte nichts selektiert werden.", _
48, "   Hinweis für " & Application.UserName
End If
Exit Sub
ListBox_fuellen:
ReDim Preserve vTemp(24, lTemp)
vTemp(0, lTemp) = WkSh.Range("A" & rZelle.Row).Value
vTemp(1, lTemp) = WkSh.Range("B" & rZelle.Row).Value
vTemp(2, lTemp) = WkSh.Range("C" & rZelle.Row).Value
vTemp(3, lTemp) = WkSh.Range("D" & rZelle.Row).Value
vTemp(4, lTemp) = WkSh.Range("E" & rZelle.Row).Value
vTemp(5, lTemp) = WkSh.Range("F" & rZelle.Row).Value
vTemp(6, lTemp) = WkSh.Range("G" & rZelle.Row).Value
vTemp(7, lTemp) = WkSh.Range("H" & rZelle.Row).Value
vTemp(8, lTemp) = WkSh.Range("I" & rZelle.Row).Value
vTemp(9, lTemp) = Format(WkSh.Range("J" & rZelle.Row).Value, "dd.mm.yyyy")
vTemp(10, lTemp) = Format(WkSh.Range("K" & rZelle.Row).Value, "YY")
vTemp(11, lTemp) = WkSh.Range("L" & rZelle.Row).Value
vTemp(12, lTemp) = WkSh.Range("M" & rZelle.Row).Value
vTemp(13, lTemp) = WkSh.Range("N" & rZelle.Row).Value
vTemp(14, lTemp) = WkSh.Range("O" & rZelle.Row).Value
vTemp(15, lTemp) = WkSh.Range("P" & rZelle.Row).Value
vTemp(16, lTemp) = WkSh.Range("Q" & rZelle.Row).Value
vTemp(17, lTemp) = WkSh.Range("R" & rZelle.Row).Value
vTemp(18, lTemp) = WkSh.Range("S" & rZelle.Row).Value
vTemp(19, lTemp) = WkSh.Range("T" & rZelle.Row).Value
vTemp(20, lTemp) = WkSh.Range("U" & rZelle.Row).Value
vTemp(21, lTemp) = WkSh.Range("V" & rZelle.Row).Value
vTemp(22, lTemp) = WkSh.Range("W" & rZelle.Row).Value
vTemp(23, lTemp) = WkSh.Range("X" & rZelle.Row).Value
vTemp(24, lTemp) = WkSh.Range("Y" & rZelle.Row).Value
lTemp = lTemp + 1
Return
End Sub

Gruß Peter

Anzeige
Guten Morgen -)
11.05.2014 09:03:47
walter
Guten Morgen Peter,
recht herzlichen Dank funktioniert einwandfrei !
Schönen Sonntag noch !
mfg
walter mg

AW: Makro Fehler drin...
10.05.2014 22:30:39
Ewald
Hallo,
ein einfaches Beispiel
  Dim vntData As Variant   'muss IMMER Variant Datentyp sein!
Dim objRng  As Range
Dim objWks  As Worksheet
'Tabelle mit Daten welche ins Array müssen
Set objWks = ThisWorkbook.Worksheets("Tabelle3")
'Zelle mit Daten welche ins Array müssen,
Set objRng = objWks.Range(objWks.Cells(6, 1), objWks.Cells(6, 25))  '6 = deine rZeile.Row
'Werte der Zellen in Array schreiben
vntData = objRng.Value
ListBox1.List = vntData

Gruß Ewald

Anzeige
Werde gleich testen
11.05.2014 09:04:49
walter
Guten Morgen Ewald,
werde gleich mal Testen und Berichte,
gruß
walter mg

AW: Werde gleich testen
11.05.2014 09:58:41
Hajo_Zi
Hallo Walter,
warum offen, soll jemand vorbei kommen und Helfen?

Nein Hajo, brauch keiner...
11.05.2014 10:15:07
walter
Guten Morgen Hajo,
aus meiner Sicht gehört es sich, wenn jemand unterstützt, dass man auch
eine Anwort gibt.
Dies habe ich Ewald auch gemeldet.
So und jetzt werden ich den TEST von Ewald durchführen.
Schönen Sonntag noch Hajo,
mfg
walter mg

Antwort ist OK, aber nicht auf offen stellen...
11.05.2014 10:19:38
robert
Hi,
Eine Antwort zu geben ist OK, aber der Beitrag sollte dadurch nicht
auf OFFEN gestellt werden.
Die Liste der offenen Beiträge wir dadurch unnötig verlängert.
OK ?
Gruß
robert

Anzeige
Danke für den Hinweis Robert ! --))
11.05.2014 10:24:18
walter

AW: Nein Hajo, brauch keiner...
11.05.2014 10:21:10
Hajo_Zi
Hallo Walter,
das hatte ich auch nicht bemängelt.
warum offen

Darum meine Frage
soll jemand vorbei kommen und Helfen?
Gruß Hajo

Hallo Ewald
11.05.2014 10:23:32
walter
Hallo Ewald,
habe es leider nicht geschafft dein Beispiel bei meinem Makro einzusetzen,
vielleicht hast Du noch ein Beispiel, sonst nehme ich das Makro von Peter.
mfg
walter mg

Hallo Ewald
11.05.2014 10:56:19
walter
Hallo Ewald,
konnte dein Makro leider nicht einbinden.
Vielleicht, wenn Du ZEIT hast, mal mein Makro nehmen und dein Beispiel
einbinden.
Ansonsten schönen Sonntag noch,
gruß Walter mg

Anzeige
AW: Hallo Ewald
11.05.2014 18:57:13
Ewald
Hallo Walter,
habe mir jetzt mal den Code genau angesehen, da ist ja Find Next und verschiedene Suchspalten drin, da geht das mit der Range-Methode nicht.
Habe das ganze mal so gemacht,
Es kann nur nach Textbox1 gesucht werden
Es kann nur nach Textbox2 gesucht werden
Es kann nach beiden Textboxen gesucht werden
Eingabe in die Textboxen kann ein Großbuchstabe,ein Teil des Suchbegriffs oder der volle Name sein.
bei der Suche bei zwei Textboxen mit vollem Namen sollte ein eindeutiger Eintrag erscheinen,falls es nicht auch Namen und Firmennamen doppelt gibt
Bei deiner Suche mit Einzelbuchstabe ist mir nicht klar, was da passieren soll, da die Suchspalte jetzt A ist.
Hier der Code
Private Sub CommandButton4_Click()
Dim SN As String
Dim SN2 As String
Dim myrow As Long
Dim lngrow As Long
Dim ws As Worksheet
Dim myarr()
Dim i As Long
Dim j As Long
Dim k As Long
Dim z As Long
z = 0
Set ws = ThisWorkbook.Sheets("Datenbank")
myrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
SN = TextBox1.Text
SN2 = TextBox2.Text
If SN = "" And SN2 = "" Then MsgBox "ohne Eingabe keine Suche"
If SN  "" And SN2 = "" Then 'Nach Textbox1 suchen
ReDim myarr(myrow, 26)
With ws
For i = 1 To myrow
If InStr(.Cells(i, 3).Value, SN) > 0 Then
For j = 1 To 26
myarr(z, j) = .Cells(i, j).Value
Next
z = z + 1
End If
Next
If z = 0 Then MsgBox "Es wurde nichts gefunden"
End With
For k = 0 To UBound(myarr)
myarr(k, 10) = Format(myarr(k, 10), "dd.mm.yyyy")
myarr(k, 11) = Format(myarr(k, 11), "yy")
Next
ListBox1.List = myarr
End If
If SN = "" And SN2  "" Then   'Nach TextBox2 suchen
ReDim myarr(myrow, 26)
With ws
For i = 1 To myrow
If InStr(.Cells(i, 8).Value, SN2) > 0 Then
For j = 1 To 26
myarr(z, j) = .Cells(i, j).Value
Next
z = z + 1
End If
Next
If z = 0 Then MsgBox "Es wurde nichts gefunden"
End With
For k = 0 To UBound(myarr)
myarr(k, 10) = Format(myarr(k, 10), "dd.mm.yyyy")
myarr(k, 11) = Format(myarr(k, 11), "yy")
Next
ListBox1.List = myarr
End If
If SN  "" And SN2  "" Then   'Nach TextBox1 und Textbox2 suchen
ReDim myarr(myrow, 26)
With ws
For i = 1 To myrow
If InStr(.Cells(i, 3).Value, SN) > 0 And InStr(.Cells(i, 8).Value, SN2) > 0 Then
For j = 1 To 26
myarr(z, j) = .Cells(i, j).Value
Next
z = z + 1
End If
Next
If z = 0 Then MsgBox "Es wurde nichts gefunden"
End With
For k = 0 To UBound(myarr)
myarr(k, 10) = Format(myarr(k, 10), "dd.mm.yyyy")
myarr(k, 11) = Format(myarr(k, 11), "yy")
Next
ListBox1.List = myarr
End If
End Sub
Gruß Ewald

Anzeige
Guten Morgen Ewald, leider...
12.05.2014 09:14:02
walter
Guten Morgen Ewald,
leider Fehlermeldung.
Bleibt hier stehen:
Me.ListBox1.List = myarr
Laufzeitfehler 70
Zugriff verweigert.
mfg
walter mg

AW: Nachtrag
12.05.2014 13:00:10
Ewald
Hallo Walter,
bei Laufzeitfehler 70 könnte es auch sein das in den Eigenschaften der Listbox die Row Source gesetzt ist.
Gruß Ewald

Danke für den Nachtrag -)
12.05.2014 18:53:40
walter
Hallo Ewald,
danke für die Musterdatei, Row Source ist nicht gesetzt.
Werde deine Musterdatei mal für mich anpassen,
danke.
gruß walter mg
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige