PDA

Vollständige Version anzeigen : Suchfunktion mit Makro und VBA


Sty
26.11.2013, 08:31
Hallo Leute,

ich habe eine Excel die aus 4 Tabellen besteht.
3 Tabellen sind vol mit Farbbezeichnungen und deren Farben, und in der ersten Tabelle möchte ich nach der jeweiligen Farbe suchen und anzeigen lassen.

Ich komme leider überhaupt nicht weiter.


Private Sub Worksheet_Change(ByVal Target As Range)

Dim Farbe As String

If Target.Address = "$D$6" Then
Call Farbsuche
End If


End Sub

Private Sub Farbsuche()


Dim Farbe As String

Farbe = Range("D6").Value
Range("B13").Value = Farbe
MsgBox " " & Farbe & " "

' hier sollte anch der Farbe gesucht werden in den Tabellen NCS Ral und Sikkens


End Sub

soweit bin ich.

Ich habe auch die Excel mal angehängt. Ich freue mich über alle Hilfe. Ich glaube nicht dass es soooo schwer ist, aber ich finde auch mit google leider kein Lösungsansatz.


Vielen dank im Voraus!

Hajo_Zi
26.11.2013, 08:44
es wäre von Vorteil gewesen hättest Du eine Farbe eingetragen die vorhanden ist.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Farbe As String
If Target.Address = "$D$6" Then
Farbsuche Target
End If
End Sub

Private Sub Farbsuche(StTargetAktuell)
Dim RaFound As Range
Set RaFound = Worksheets("NCS").Cells.Find(StTargetAktuell, , , xlPart, , xlNext)
If Not RaFound Is Nothing Then
MsgBox " Farbe wurde gefunden in Tabele NCS Zelle" & RaFound.Address
Else
Set RaFound = Worksheets("RAL").Cells.Find(StTargetAktuell, , , xlPart, , xlNext)
If Not RaFound Is Nothing Then
MsgBox " Farbe wurde gefunden in Tabele RAL Zelle" & RaFound.Address
Else
Set RaFound = Worksheets("Sikkens").Cells.Find(StTargetAktuell, , , xlPart, , xlNext)
If Not RaFound Is Nothing Then
MsgBox " Farbe wurde gefunden in Tabele Sikkens Zelle" & RaFound.Address
Else
MsgBox "Farbe wurde nicht gefunden"
End If
End If
End If
Set RaFound = Nothing
End Sub


<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm" onclick="window.open(this.href);return false"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

Sty
26.11.2013, 08:51
wow das ging ja schnell, vielen vielen Dank schonmal für die Message Box.

geschickt wäre halt, wenn der Name in Tabelle Suche Zelle B13 und die Farbe in Zelle B18 kopiert werden würde. Das ist das zweite was ich nicht konnte abgesehen von der Suche ;)

Hajo_Zi
26.11.2013, 08:55
das verstehe ich nicht. Es sollte in allen gesucht werden, was ja auch passiert.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Sty
26.11.2013, 09:00
ja das stimmt, aber das Ergebnis soll nicht in einer MessageBox angezeigt werden, sondern in die entsprechenden Felder eingetragen werden.

Ich habe ein Beispiel angehängt.
71000

Hajo_Zi
26.11.2013, 09:07
bei mir sind es je Tabelle 16.384x 1.048.576 Zelle, für VBA sollte die Zelle schon klar vorgegeben werden.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Sty
26.11.2013, 09:18
Das verstehe ich nun wiederrum nicht :)

Haben Sie meine angehängte Excel im letzten Post gesehen?

Hajo_Zi
26.11.2013, 09:19
Nein es Bestand kein Grund dafür, für Probleme ist der Beitrag da und darauf Antworte ich.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Sty
26.11.2013, 09:27
ok dann versuche ich es zu formulieren:

in den Tabellen stehen die Farbbezeichnungen und daneben oder darüber (je nach Tabelle) ist eine formatierte Zelle, die mit der Farbe ausgefüllt ist.
Diese formatierte Zelle möchte ich nach Feld B17 kopieren und den entsprechenden Namen in Feld B13.

Hajo_Zi
26.11.2013, 09:30
Rafound.copy Range("B17")
Teil 2 keine Ahnung. ich vermute was mit Offset.
Ich speichere keine Datei aus einem Forum.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Sty
26.11.2013, 09:40
hier habe ich 3 Screenshots:
Sikkens und Ral sind identisch vom Aufbau.
Feld B17 ist eigentlich das Wichtigste an dem Prozedere :)

Hajo_Zi
26.11.2013, 09:46
ich bin dann raus, mein Excel kann keine Bilder öffnen. Ich sehe auch keinen Grund warum ich das öffnen soll.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Sty
26.11.2013, 09:48
das sind doch nur screenshots von meiner Escel Datei, um zu visualisieren was erreicht werden soll. Ist es denn nicht möglich die Formatierung eines Feldes (Hintergrundfarbe) zu kopieren über das VBA?

hary
26.11.2013, 13:00
Moin
Versuchs so.
Private Sub Farbsuche(StTargetAktuell)
Dim wks As Worksheet
Dim RaFound As Range
Dim zeile As Long
Dim spalte As Long
For Each wks In Worksheets
If wks.Name <> "Suche" Then
Set RaFound = wks.Cells.Find(StTargetAktuell, , , xlPart, , xlNext)
If Not RaFound Is Nothing Then
Select Case wks.Name
Case "NCS"
zeile = -1
spalte = 0
Case "RAL"
zeile = 0
spalte = 1
Case "Sikkens"
zeile = 0
spalte = -1
End Select
Worksheets("Suche").Cells(13, 2) = StTargetAktuell
Worksheets("Suche").Cells(18, 2).Interior.Color = wks.Range(RaFound.Address).Offset(zeile, spalte).Interior.Color
Exit For
End If
End If
Next
If RaFound Is Nothing Then MsgBox "Wert nicht gefunden", vbInformation, "Hinweis"
Set RaFound = Nothing
End Sub

gruss hary

Hasso
26.11.2013, 13:21
Hallo Sty,

so klappt's bei mir:Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Farbe As String

If Target.Address = "$D$6" Then
Call Farbsuche(Target)
End If


End Sub

Private Sub Farbsuche(ByVal strFarbbezeichnung As String)

Dim rngZelle As Range
Dim strFarbe As String
If Left(strFarbbezeichnung, 2) = "S " Then 'NCS-Farben
For Each rngZelle In Worksheets("NCS").UsedRange
If rngZelle = strFarbbezeichnung Then
Worksheets("suche").Range("B18").Interior.Color = rngZelle.Offset(1, 0).Interior.Color
End If
Next rngZelle
End If

If InStr(strFarbbezeichnung, ".") Then 'Sikkens-Farben
For Each rngZelle In Worksheets("Sikkens").UsedRange
If rngZelle = strFarbbezeichnung Then
Worksheets("suche").Range("B18").Interior.Color = rngZelle.Offset(0, -1).Interior.Color
End If
Next rngZelle
End If

If Left(strFarbbezeichnung, 3) = "RAL" Then 'RAL-Farben
For Each rngZelle In Worksheets("RAL").UsedRange
If rngZelle = strFarbbezeichnung Then
Worksheets("suche").Range("B18").Interior.Color = rngZelle.Offset(0, 1).Interior.Color
End If
Next rngZelle
End If

End Sub

Sty
26.11.2013, 14:04
ihr seid meine Helden :)

Vielen Dank !!!!