Groß-und Kleinschreibung bei Suche ingnorieren
#11
Hallo Frank,

wie bereits Uwe schon geschrieben hat: Mit Option Compare Text geht es. Und wie von mir erwähnt, das gehört oben hin. Also vor deinem Listbox1_Click-Ereignis.

Code:
Option Compare Text

Private Sub ListBox1_Click()
ListBox1.ListFillRange = "Suche"
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

If Tabelle1.Range("H5").Value = 0 Then
MsgBox "Sie müssen einen Vertrag auswählen !", , "Fehlermeldung"
End If

If Not Tabelle1.Range("H5").Value = 0 Then

'Datensatz aus Archiv holen und ins Suchergebnis eintragen

Dim i As Long, tLR As Long
Dim ZielWks As Worksheet, QuelleWks As Worksheet

Set QuelleWks = Worksheets("Firmenverträge")
Set ZielWks = Worksheets("Suchergebnis_Firmenverträge")

Range("H5").Copy
Range("H6").PasteSpecial xlPasteValues
Application.CutCopyMode = False

Range("A1").Select

Worksheets("Suchergebnis_Firmenverträge").Rows("2:" & Worksheets("Suchergebnis_Firmenverträge").Rows.Count).ClearContents

With QuelleWks
    For i = 1 To .Cells(.Rows.Count, 11).End(xlUp).Row

        If .Cells(i, 1).Value = (Tabelle1.Range("H6").Value) Then
            tLR = ZielWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Debug.Print tLR
            
            With ZielWks
            .Range(.Cells(tLR, 1), .Cells(tLR, 23)).Value = QuelleWks.Range(QuelleWks.Cells(i, 1), _
QuelleWks.Cells(i, 23)).Value
QuelleWks.Rows(i).Delete
            End With
        End If
    Next i
End With

SucheVertrag = ""

frmFirmenvertrag_3.Show

End If

End Sub

Private Sub SucheVertrag_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Dim i As Long, tLR As Long
Dim ZielWks As Worksheet, QuelleWks As Worksheet

Set QuelleWks = Worksheets("Firmenverträge")
Set ZielWks = Worksheets("Suchergebnis_Firmenverträge")

Worksheets("Suchergebnis_Firmenverträge").Rows("2:" & Worksheets("Suchergebnis_Firmenverträge").Rows.Count).ClearContents

With QuelleWks
    For i = 2 To .Cells(.Rows.Count, 23).End(xlUp).Row
  
        If .Cells(i, 3).Value Like SucheVertrag & "*" Then
           tLR = ZielWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Debug.Print tLR
            With ZielWks
            .Range(.Cells(tLR, 1), .Cells(tLR, 7)).Value = QuelleWks.Range(QuelleWks.Cells(i, 1), _
QuelleWks.Cells(i, 7)).Value
            End With
        End If
    Next i
End With

End Sub
Gruß Stefan
Win 10 / Office 2016
Top
#12
Super, das klappt perfekt !!

Kannst du mir noch sagen wie ich es schaffe das sich die Listbox beim schließen leert?

Gruß Frank
Top
#13
Hallo Frank,

ich gehe davon aus, dass Du den Schließenbutton auf dem Tabellenblatt Start meinst (der Code dazu befindet sich im Modul1

Code:
Sub Schliessen()
Tabelle1.ListBox1.ListFillRange = ""
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub

und noch ganz wichtig eine Änderung im Code Workbook_Open im Klassenmodul DieseArbeitsmappe
Code:
Private Sub Workbook_Open()



Dim i As Long, tLR As Long
Dim ZielWks As Worksheet, QuelleWks As Worksheet

Set QuelleWks = Worksheets("Firmenverträge")
Set ZielWks = Worksheets("Suchergebnis_Firmenverträge")

Worksheets("Suchergebnis_Firmenverträge").Rows("2:" & Worksheets("Suchergebnis_Firmenverträge").Rows.Count).ClearContents

'folgende Codezeile wurde eingefügt
Tabelle1.ListBox1.ListFillRange = "Suche"

With QuelleWks
    For i = 2 To .Cells(.Rows.Count, 23).End(xlUp).Row
  
        'If .Cells(i, 5).Value = "offen" Then
            tLR = ZielWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Debug.Print tLR
            With ZielWks
            .Range(.Cells(tLR, 1), .Cells(tLR, 23)).Value = QuelleWks.Range(QuelleWks.Cells(i, 1), _
QuelleWks.Cells(i, 23)).Value
            End With
        'End If
    Next i
End With

  
Worksheets("Start").Activate
Range("H5").Value = 0
Range("A1").Select


End Sub
Gruß Stefan
Win 10 / Office 2016
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste