Supportnet Computer Supportnet Games Supportnet Kochen Explipedia
Login: guestBesucher online: 293
Supportnet Computerforum
SUPPORT
Home
Forum
Tipps & Infos
Blitz Angebote
Members
Hilfe
Video

TOP THEMEN
SSD Test
Alles über SSDs

Android Tipps
iPad Tipps
Google Tipps
Windows 8 FAQ
Windows 7 FAQ
E-Mail FAQ
Netzwerk FAQ
Festplatten FAQ
Datenrettung FAQ
Bildbearbeitung FAQ

Top iPhone Apps
Computer Einsteiger
Die 5 besten...
Explipedia
Themen
Direktlinks

Neue Einträge
News einsenden News einschicken
Tipps einsenden Tipp einschicken

SN-LINKS

Suche
Befreundete Seiten
Top Seiten

Supportnet/Forum/Tabellenkalkulation



Supportnet/Forum/Tabellenkalkulation
von Tim2017c vom 19.03.2017, 10:29 Diese Seite den Supportnet Favoriten hinzufügen  Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden


VBA soll Zahl ermitteln

 (271 Hits)

Hi Forum

Ich suche eine VBA Lösung die folgendes macht.

In Tabelle1 B2 steht eine Zahl z.b 9 diese ist Variable und ändert sich
ständig bei jedem Durchlauf.

In Tabelle 2 sind meine "Archiv Nummern" einige werden mit einem
Makro in .Interior.ColorIndex = 28 eingefärbt.

Jetzt soll nach .Interior.ColorIndex = 28 gesucht werden
wenn unterhalb der gesuchten Farbe
die Zahl aus der Tabelle 1 B2 zb 9 steht dann
kopiere die erste Zahl oberhalb von der Farbe in Tabelle 3

Läst sich das irgendwie machen wäre toll


mfg
Tim2017c


Antwort schreiben 50 Bonuspunkte

Antworten...
Antwort 1 von Nighty__ vom 19.03.2017, 11:40 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Tim2017c .-)

Wie gewünscht!

Gruss Nighty

In diesem Beispiel werden in allen drei Blättern Spalte A genutzt

Sub Suchen()
    Dim Zelle As Long
    Dim Suche As Object
    Dim KDat As Variant
    KDat = Worksheets(2).Range("A1:A" & Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row)
    For Zelle = 2 To UBound(KDat)
        If KDat(Zelle, 1) = Worksheets(1).Range("A2") Then
            If Worksheets(2).Cells(Zelle - 1, 1).Interior.ColorIndex = 28 Then
                Worksheets(3).Cells(Worksheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = KDat(Zelle - 2, 1)
            End If
        End If
    Next Zelle
End Sub


Antwort noch nicht bewertet
Antwort 2 von Nighty__ vom 19.03.2017, 11:44 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Community ^^

ops ... Dim Suche As Object
kann gelöscht werden,waren noch Altlasten :-)

Gruss Nighty


Antwort noch nicht bewertet
Antwort 3 von Nighty__ vom 19.03.2017, 12:42 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Tim2017c .-)

Oder auch so!

Blatt 1 mit unbestimmter Anzahl von Suchbegriffen

Gruss Nighty

Sub Suchen()
    Dim ZielZelle As Long, SuchZelle As Long
    Dim QuellDat As Variant, SuchDat As Variant
    SuchDat = Worksheets(1).Range("A1:A" & Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
    QuellDat = Worksheets(2).Range("A1:A" & Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row)
    For SuchZelle = 2 To UBound(SuchDat)
        For ZielZelle = 2 To UBound(QuellDat)
            If QuellDat(ZielZelle, 1) = SuchDat(SuchZelle, 1) Then
                If Worksheets(2).Cells(ZielZelle - 1, 1).Interior.ColorIndex = 28 Then
                    Worksheets(3).Cells(Worksheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = QuellDat(ZielZelle - 2, 1)
                End If
            End If
        Next ZielZelle
    Next SuchZelle
End Sub


Antwort noch nicht bewertet
Antwort 4 von Tim2017c vom 19.03.2017, 18:26 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hi Nighty

Es läuft nur bedingt

Er müsste mir das ganze Tabellenblatt wo meine eingefärbten Nummern sind durchsuchen.
Ebenfalls wäre es super wenn er das Tabellenblatt 3 dann wieder löscht wenn man das Makro wieder benutzt.

mfg
Tim2017c


Antwort noch nicht bewertet
Antwort 5 von Nighty__ vom 19.03.2017, 19:23 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Tim2017c .-)

Dann probier mal das Makro :-)

Gruß Nighty

Sub Suchen()
    Dim SuchZelle As Long
    Dim QuellDat As Variant, SuchDat As Variant, ZielZelle As Variant
    Worksheets(3).Cells.Clear
    SuchDat = Worksheets(1).Range("A1:A" & Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
    Set QuellDat = Worksheets(2).Range(Worksheets(2).Cells(1, 1), Worksheets(2).Cells(22, 2))
    For SuchZelle = 2 To UBound(SuchDat)
        For Each ZielZelle In QuellDat
            If QuellDat(ZielZelle.Row, ZielZelle.Column) = SuchDat(SuchZelle, 1) Then
                If Worksheets(2).Cells(ZielZelle.Row - 1, ZielZelle.Column).Interior.ColorIndex = 3 Then
                    Worksheets(3).Cells(Worksheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = QuellDat(ZielZelle.Row - 2, ZielZelle.Column)
                End If
            End If
        Next ZielZelle
    Next SuchZelle
End Sub


Antwort noch nicht bewertet
Antwort 6 von Nighty__ vom 19.03.2017, 19:39 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Tim2017c und Community .-)

Korrigiert!

Gruss Nighty

Sub Suchen()
    Dim SuchZelle As Long
    Dim QuellDat As Variant, SuchDat As Variant, ZielZelle As Variant
    Worksheets(3).Cells.Clear
    SuchDat = Worksheets(1).Range("A1:A" & Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
    Set QuellDat = Worksheets(2).Range(Worksheets(2).Cells(1, 1), Worksheets(2).Cells(Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row, Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Column))
    For SuchZelle = 2 To UBound(SuchDat)
        For Each ZielZelle In QuellDat
            If QuellDat(ZielZelle.Row, ZielZelle.Column) = SuchDat(SuchZelle, 1) Then
                If Worksheets(2).Cells(ZielZelle.Row - 1, ZielZelle.Column).Interior.ColorIndex = 3 Then
                    Worksheets(3).Cells(Worksheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = QuellDat(ZielZelle.Row - 2, ZielZelle.Column)
                End If
            End If
        Next ZielZelle
    Next SuchZelle
End Sub


Antwort noch nicht bewertet
Antwort 7 von Nighty__ vom 19.03.2017, 20:05 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Tim2017c .-)

Du musst noch die 3 durch 28 ersetzen (Farbindex)

  If Worksheets(2).Cells(ZielZelle.Row - 1, ZielZelle.Column).Interior.ColorIndex = 3 Then


Gruss Nighty


Antwort noch nicht bewertet
Antwort 8 von Tim2017c vom 19.03.2017, 20:34 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hi nighty

Es funktioniert zwar aber nicht ganz richtig
wenn du die 16 eingiebst als unter Zahl von der Farbe müsste er die 33 finden
ist aber leider nicht so.

hab die Mappe mal hochgeladen damit du siehst was ich meine
http://www.filehosting.at/file/details/650555/Mappe1.xlsm

Vielen Dank für dein Bemühen


Antwort noch nicht bewertet
Antwort 9 von Nighty__ vom 19.03.2017, 21:24 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Tim2017c .-)

Bitte im xls Format(Excel2000),unter saveas erreichbar!

Gruss Nighty


Antwort noch nicht bewertet
Antwort 10 von Tim2017c vom 19.03.2017, 21:36 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hi nighty
http://www.filehosting.at/file/details/650571/Mappe1c.xls

bitteschön


Antwort noch nicht bewertet
Antwort 11 von Nighty__ vom 19.03.2017, 21:53 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Tim2017c .-)

Funktioniert leider nicht der Filehoster!

Schick nochmal an mein Emailfach
Oberley@t-online.de

Gruss Nighty


Antwort noch nicht bewertet
Antwort 12 von Nighty__ vom 20.03.2017, 11:00 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Tim2017c .-)

Ich hab das mal auf RGB umgestellt!
Probier mal!
Ansonsten schick die Datei an meine Emailadresse!

Gruss Nighty

Farbindex 28 ist RGB=0, 255, 255 als Grundeinstellung
Bei bedarf anpassen

Sub Suchen()
    Dim SuchZelle As Long
    Dim QuellDat As Variant, SuchDat As Variant, ZielZelle As Variant
    Worksheets(3).Cells.Clear
    SuchDat = Worksheets(1).Range("A1:A" & Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
    Set QuellDat = Worksheets(2).Range(Worksheets(2).Cells(1, 1), Worksheets(2).Cells(Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row, Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Column))
    For SuchZelle = 2 To UBound(SuchDat)
        For Each ZielZelle In QuellDat
            If QuellDat(ZielZelle.Row, ZielZelle.Column) = SuchDat(SuchZelle, 1) Then
                If RGBwerteAddieren(Worksheets(2).Cells(ZielZelle.Row - 1, ZielZelle.Column), 0, 255, 255) = True Then
                    Worksheets(3).Cells(Worksheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = QuellDat(ZielZelle.Row - 2, ZielZelle.Column)
                End If
            End If
        Next ZielZelle
    Next SuchZelle
End Sub

Function RGBwerteAddieren(Zellen As Range, Rrgb As Integer, Grgb As Integer, Brgb As Integer) As Boolean
Dim Rot As Long, Grün As Long, Blau As Long, Wert As Long
Wert = Zellen.Interior.Color
Rot = Wert Mod 256
Wert = (Wert - Rot) / 256
Grün = Wert Mod 256
Wert = (Wert - Grün) / 256
Blau = Wert Mod 256
If Rrgb = Rot And Grgb = Grün And Brgb = Blau Then RGBwerteAddieren = True
End Function


Antwort noch nicht bewertet
Antwort 13 von Tim2017c vom 20.03.2017, 12:26 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hi Nighty_

Passt Perfekt

Danke


Antwort noch nicht bewertet




Hinweis
Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum.

MACHEN SIE IHRE WEBSITE ATTRAKTIVER
Sie haben eine eigene Website und wollen Ihre Besucher auf den Supportnet-Service aufmerksam machen? Kopieren Sie einfach den Quellcode in Ihre Seite und jeder Besucher Ihrer Seite kann direkt auf die Supportnet-Datenbank zugreifen.

My Supportnet


SUCHE

Gruppen im Forum
Betriebsysteme
Software
Hardware
Netzwerk
Programmierung
Sonstiges

Impressum © 1997-2015 SupportNet
Version: supportware 1.8.230E / 18.10.2010, Startzeit:Mon Jun 26 21:36:45 2017