UserForm / neues Sheet erstellen
20.07.2003 20:08:04
Erich M.
ich habe eine UserForm in der Dateinamen eingelesen werden. Der Aufruf des Makros (UserForm) soll dabei von einer x-beliebigen Datei erfolgen. Ergebnis ist des Makros ist, dass gesuchte Werte in ein (neues) Sheet Gefundene Werte eingetragen werden.
Das Makro funktioniert einwandfrei und hat nur noch einen Fehler:
Das Ergebnis der Datensuche soll immer in die Datei eingetragen werden, in der gesucht wird. Leider kann ich die Suche immer nur in der Datei anstossen, in der die UserForm ist.
Es müsste der Code ergänzt werden, dass in der Datei (= ComboBox1.Text) das Sheet Gefundene Werte ergänzt / erstellt wird.
Private Sub CommandButton1_Click()
Dim zeile1 As Long, zeile2 As Long, Tab1 As Worksheet, Tab2 As Worksheet
Dim myName1 As String, Auswahl As String
Dim myWert As Integer, mySpalte As Integer
Dim myName2 As String, gefunden As Boolean
Dim zelle As Range, Tb(1 To 15) As Worksheet, zeile As Long
If ComboBox1.Text = "" Then MsgBox "Bitte Datei auswählen.", 48, "Hinweis": Exit Sub
If ComboBox2.Text <> "" Then Set Tb(1) = Workbooks(ComboBox1.Text).Worksheets(ComboBox2.Text) Else MsgBox "Bitte Tabellenblatt 1 auswählen.", 48, "Hinweis": Exit Sub
If ComboBox3 = "" Then MsgBox "Beschreibung auswählen.", 48, "Hinweis": Exit Sub
If ComboBox4 = "" Then MsgBox "Bitte Suchspalte auswählen.", 48, "Hinweis": Exit Sub
myWert = TextBox1.Text 'Suchbegriff Wert
Auswahl = ComboBox3.Text 'kleiner oder gleich
myName1 = ComboBox2.Text 'Suchtabelle
mySpalte = ComboBox4.Text 'Suchspalte in Suchtabelle
' Sheets(myName1).Activate
For Each Tb(3) In ThisWorkbook.Worksheets
If Tb(3).Name = "Gefundene Werte" Then gefunden = True: Exit For
Next
If Not gefunden Then
Worksheets.Add.Move After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Gefundene Werte"
End If
Set Tb(3) = ThisWorkbook.Worksheets("Gefundene Werte")
With Tb(3)
.Cells.Clear
.Cells(1, 1) = "Der Wert " & Auswahl & " " & myWert & " wurde in " & myName1 & " in der Spalte " & mySpalte & " gefunden"
End With
' Sheets(myName1).Activate
' Range("A1").Select
Set Tab1 = Sheets(ComboBox2.Text) ' = Ausgangstabelle, Suchtabelle
Set Tab2 = Sheets("Gefundene Werte") ' = Eingabetabelle
If Auswahl = "=" Then
If Tab2.Cells(1, 1) = "" Then zeile2 = 2 Else zeile2 = Tab2.Cells(65536, 1).End(xlUp).Row + 1
For zeile1 = mySpalte To Tab1.Cells(65536, mySpalte).End(xlUp).Row
If Tab1.Cells(zeile1, mySpalte) = myWert Then Tab1.Rows(zeile1).Copy Tab2.Rows(zeile2)
zeile2 = Tab2.Cells(65536, 1).End(xlUp).Row + 1
Next
ElseIf Auswahl = "<" Then
If Tab2.Cells(1, 1) = "" Then zeile2 = 2 Else zeile2 = Tab2.Cells(65536, 1).End(xlUp).Row + 1
For zeile1 = mySpalte To Tab1.Cells(65536, mySpalte).End(xlUp).Row
If Tab1.Cells(zeile1, mySpalte) < myWert Then Tab1.Rows(zeile1).Copy Tab2.Rows(zeile2)
zeile2 = Tab2.Cells(65536, 1).End(xlUp).Row + 1
Next
End If
Unload Me
Sheets("Gefundene Werte").Activate
Range("B2").Select
ActiveWindow.FreezePanes = True
Range("G1").Select
End Sub
Code eingefügt mit: Excel Code Jeanie
Besten Dank für eine Hilfe!
mfg
Erich