VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
VBA - Search Function durch Textfeld + Farb Makierung	22.07.2011 10:54:20	Liveplay
VBA - Search Function durch Textfeld + Farb Makierung	22.07.2011 20:53:37	Dekor
VBA - Search Function durch Textfeld + Farb Makierung	26.07.2011 14:51:33	Gast91864
VBA - Search Function durch Textfeld + Farb Makierung	26.07.2011 18:43:42	Dekor
VBA - Search Function durch Textfeld + Farb Makierung	27.07.2011 05:54:44	Liveplay
VBA - Search Function durch Textfeld + Farb Makierung	27.07.2011 13:11:40	Dekor
VBA - Search Function durch Textfeld + Farb Makierung	27.07.2011 13:20:57	Gast29000

Ansicht des Beitrags:

Von:
Gast29000

Datum:
27.07.2011 13:20:57

Views:
1096

Rating:

Antwort:

Thema:
VBA - Search Function durch Textfeld + Farb Makierung

Das soll jetzt nur noch der gesamte Code sein für die Search Option ? Die hat ja eigentlich funktionietr mir geht nur um die Option Buttons, welche ich allerdings jetzt auch fertig habe :D man lernt wirklich nicht aus, thank Google :P

Mein aktueler Code:

'------------------------------------------'
'- Aufruf Tabelle Backend von Communities -'
'------------------------------------------'
Private Sub cmd_backend_tab1_Click()
Sheets("Backend").Select
End Sub
'-------------------------------------------'
'- Aufruf Tabelle Personal von Communities -'
'-------------------------------------------'
Private Sub cmd_personal_tab1_Click()
Sheets("Personal").Select
End Sub
'---------------------------------------------'
'- Aufruf Tabelle Verwaltung von Communities -'
'---------------------------------------------'
Private Sub cmd_verwaltung_tab1_Click()
Sheets("Verwaltung").Select
End Sub

Sub search_Change()

    Dim strWert As String
    Dim strSuche As String        ' Danach wird gesucht
    Dim rngFound As Range ' hier wurde es gefunden
    Dim rngFound1 As Range
    Dim strFirstAddress As String ' die Adresse der 1. Fundstelle
    Dim strNextAddress As String ' die Adresse der nächsten Fundstelle
    'Dim strFirstAddress1 As String ' die Adresse der 1. Fundstelle
    'Dim strNextAddress1 As String ' die Adresse der nächsten Fundstelle
    
    Dim zeile As Variant
    Dim wzeile As Variant
    Dim i As Integer 'Anzahl der Datensätze in Tabelle "Fxxxx"
    
    strWert = Tabelle1.search
    strWert = Replace(strWert, " ", "") 'ggf. Leerzeichen entfernen
    strSuche = strWert
    
    ' After ans Ende stellen, damit die 1. Zelle von oben auch sicher gefunden wird
    ' Suchen in Spalte E (=5) in Werten, gesamten Zellinhalt vergleichen
    Set rngFound = Columns(4).Find(What:=strSuche, After:=Cells(Rows.Count, 4), LookIn:=xlValues, LookAt:=xlWhole)
    
    'Wenn Eingabe nicht vorhanden...
    If rngFound Is Nothing Then
        Exit Sub
    End If
       
       

    If Tabelle1.search <> "" Then
    'Eingabe vorhanden...
    ' 1. Fundstelle merken fürs Abbrechen merken um FindNext abzubrechen
    strFirstAddress = rngFound.Address
    
    Do
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(0, 154, 205)
        Cells(wzeile(2), "AA") = "."
        'Cells(wzeile(2), "S") = frmMain.txtName
        'Cells(wzeile(2), "T") = frmMain.lblDatum
        
        'Weitersuchen
        Set rngFound = Columns(4).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(0, 154, 205)
        
    Loop While rngFound.Address <> strFirstAddress
    End If
    'Tabelle1.lblStatus = "gefunden"
    '------------------------------------
    If Tabelle1.search = "" Then
       Set rngFound = Columns("AA").Find(What:=".", After:=Cells(Rows.Count, "AA"), LookIn:=xlValues, LookAt:=xlWhole)
        If rngFound Is Nothing Then
            Exit Sub
        End If
    strFirstAddress = rngFound.Address
    Do
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        Cells(wzeile(2), "AA") = "."
        
        'Weitersuchen
        Set rngFound = Columns("AA").FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        Cells(wzeile(2), "AA") = "."
        
    Loop While rngFound.Address <> strFirstAddress
    
        
    End If
      
    
End Sub

'-------------------------------------'
'Software Option Button Change Event -'
'-------------------------------------'

Private Sub Software_change()

Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String

Dim zeile As Variant
Dim wzeile As Variant

wert = Tabelle1.Software

If wert = True Then
        
Set rngFound = Columns(7).Find(What:="Software", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

Loop While rngFound.Address <> strFirstAddress

End If

If wert = False Then

Set rngFound = Columns(7).Find(What:="Software", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        
        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)


Loop While rngFound.Address <> strFirstAddress


End If

End Sub

'-------------------------------------'
'Hardware Option Button Change Event -'
'-------------------------------------'

Private Sub Hardware_change()

Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String

Dim zeile As Variant
Dim wzeile As Variant

wert = Tabelle1.Hardware

If wert = True Then

Set rngFound = Columns(7).Find(What:="Hardware", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

Loop While rngFound.Address <> strFirstAddress

End If

If wert = False Then

Set rngFound = Columns(7).Find(What:="Hardware", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        
        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)


Loop While rngFound.Address <> strFirstAddress


End If

End Sub

'-----------------------------------'
'Gaming Option Button Change Event -'
'-----------------------------------'

Private Sub Gaming_change()

Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String

Dim zeile As Variant
Dim wzeile As Variant

wert = Tabelle1.Gaming

If wert = True Then

Set rngFound = Columns(7).Find(What:="Gaming", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

Loop While rngFound.Address <> strFirstAddress

End If

If wert = False Then

Set rngFound = Columns(7).Find(What:="Gaming", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        
        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)


Loop While rngFound.Address <> strFirstAddress


End If

End Sub

'-----------------------------------------'
'Grafikdesign Option Button Change Event -'
'-----------------------------------------'

Private Sub Grafikdesign_change()

Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String

Dim zeile As Variant
Dim wzeile As Variant

wert = Tabelle1.Grafikdesign

If wert = True Then

Set rngFound = Columns(7).Find(What:="Grafikdesign", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

Loop While rngFound.Address <> strFirstAddress

End If

If wert = False Then

Set rngFound = Columns(7).Find(What:="Grafikdesign", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        
        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)


Loop While rngFound.Address <> strFirstAddress


End If

End Sub

'----------------------------------'
'Musik Option Button Change Event -'
'----------------------------------'

Private Sub Musik_change()

Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String

Dim zeile As Variant
Dim wzeile As Variant

wert = Tabelle1.Musik

If wert = True Then

Set rngFound = Columns(7).Find(What:="Musik", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

Loop While rngFound.Address <> strFirstAddress

End If

If wert = False Then

Set rngFound = Columns(7).Find(What:="Musik", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        
        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)


Loop While rngFound.Address <> strFirstAddress


End If

End Sub

'-------------------------------------------'
'Programmierung Option Button Change Event -'
'-------------------------------------------'

Private Sub Programmierung_change()

Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String

Dim zeile As Variant
Dim wzeile As Variant

wert = Tabelle1.Programmierung

If wert = True Then

Set rngFound = Columns(7).Find(What:="Programmierung", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

Loop While rngFound.Address <> strFirstAddress

End If

If wert = False Then

Set rngFound = Columns(7).Find(What:="Programmierung", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        
        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)


Loop While rngFound.Address <> strFirstAddress


End If

End Sub

'------------------------------------------'
'Burning Board Option Button Change Event -'
'------------------------------------------'

Private Sub WBB_change()

Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String

Dim zeile As Variant
Dim wzeile As Variant

wert = Tabelle1.WBB

If wert = True Then

Set rngFound = Columns(7).Find(What:="Burning Board", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

Loop While rngFound.Address <> strFirstAddress

End If

If wert = False Then

Set rngFound = Columns(7).Find(What:="Burning Board", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        
        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)


Loop While rngFound.Address <> strFirstAddress


End If

End Sub

'----------------------------------'
'Joomla Option Button Change Event -'
'----------------------------------'

Private Sub Joomla_change()

Dim wert As Boolean
Dim rngFound As Range
Dim strFirstAddress As String
Dim strNextAddress As String

Dim zeile As Variant
Dim wzeile As Variant

wert = Tabelle1.Joomla

If wert = True Then

Set rngFound = Columns(7).Find(What:="Joomla", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 64, 64)

Loop While rngFound.Address <> strFirstAddress

End If

If wert = False Then

Set rngFound = Columns(7).Find(What:="Joomla", After:=Cells(Rows.Count, 7), LookIn:=xlValues, LookAt:=xlWhole)

If rngFound Is Nothing Then

Exit Sub

End If

strFirstAddress = rngFound.Address

Do
    
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        
        Set rngFound = Columns(7).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)


Loop While rngFound.Address <> strFirstAddress


End If

End Sub

Ich möchte zu gerne noch eine Password Abfrage per Userform machen aber da bin ich im Moment überfragt wie ich das machen kann. Die Userform soll auf jeden Fall aufpopen wenn Excel gestartet wird. Nur komme ich da in den Konflikt mit den User definierten Sicherheitsregeln für Makros da die Userform ja net ausgeführt wird wenn dem Makro nicht vertraut wird. Dann kann ich mit Abfrage auch sparen oder.

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
VBA - Search Function durch Textfeld + Farb Makierung	22.07.2011 10:54:20	Liveplay
VBA - Search Function durch Textfeld + Farb Makierung	22.07.2011 20:53:37	Dekor
VBA - Search Function durch Textfeld + Farb Makierung	26.07.2011 14:51:33	Gast91864
VBA - Search Function durch Textfeld + Farb Makierung	26.07.2011 18:43:42	Dekor
VBA - Search Function durch Textfeld + Farb Makierung	27.07.2011 05:54:44	Liveplay
VBA - Search Function durch Textfeld + Farb Makierung	27.07.2011 13:11:40	Dekor
VBA - Search Function durch Textfeld + Farb Makierung	27.07.2011 13:20:57	Gast29000