MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 06.01.2017, 19:08   #1
manega
MOF User
MOF User
Standard Formel - wenn Wert in Zeile >0 dann Text aus gleicher Spalte

Hallo Leute,

in meiner Tabelle ist in den Zellen der Zeilen 7 und 8 Text vorhanden, und das von Spalte C bis BT.
Die Wörter aus den Zeilen 7 und 8 sollen zusammengefügt, durch ein Leerzeichen getrennt dargestellt werden.
Das jedoch nur. wenn in Zeile 9 der entsprechenden Spalte der Wert >0 ist.

Bsp.:
C7 = Foto
C8 = Apparat
C9 = 1
Ergebnis: Foto Apparat

Das funktioniert bereits per folgender Formel:

=WENN(Info!C9>0;Info!C7&" "&Info!C8&", ";"")

Ich brauche jetzt aber eine Formel die mir den Text aus allen Spalten hintereinander auflistet, in denen in Zeile 9 der Wert >0 ist

Bsp.:
C7 = Foto...........D7 = Fleisch.....E7 = Glüh.......F7 = Schnee
C8 = Apparat.....D8 = Wolf.........E8 = Lampe....F8 = Flocke
C9 = 1................D9 =.................E9 = 1.............F9 =
Ergebnis: Foto Apparat, Glüh Lampe

Eine WENN Verschachtelung ist glaube ich bei 70 Mal auch nicht mehr möglich, oder aber sehr aufwendig.
Ich hoffe, dass jemand von euch eine andere Lösung hat.

Vielen Dank schon mal im Voraus.
Gruß manega

Geändert von manega (06.01.2017 um 19:46 Uhr). Grund: aussagekräftigerer Titel
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 06.01.2017, 21:53   #2
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

Zitat:

Ich hoffe, dass jemand von euch eine andere Lösung hat.

Zum Beispiel eine VBA-Lösung:
Code:

Option Explicit

Sub Zusammensetzen()
    Dim c As Long           'Spalten#
    Dim erg As Variant      'Ergebnis
    Dim sw As Boolean       'Schalter True=Komma voranstellen
    
    For c = Range("C7").Column To Range("BT7").Column
        If Cells(9, c) > 0 Then
            erg = erg & IIf(sw = True, ", ", "") & Cells(7, c) & " " & Cells(8, c)
            sw = True
        End If
    Next c
    
    Range("C12") = erg      ' Ergebnis nach Zeile 12
End Sub
Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.01.2017, 08:59   #3
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

das funktioniert super. Vielen Dank!
Könntest du mir den Code bitte noch so umstellen, dass die auszulesenden Daten in
Tabelle "Info" stehen und das Ergebnis in Tabelle "Details"! Das Makro würde dann aus Tabelle "Details" gestartet werden.
Das wäre super!

Gruß manega

Geändert von manega (07.01.2017 um 09:00 Uhr). Grund: Fehler
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.01.2017, 11:38   #4
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

nachstehend das angepasste Makro; ggf ist die Zieladresse noch zu ändern !
Den CommandButton1 in der Tabelle 'Details' einzufügen dürfte vermutlich keine Probleme bereiten, ansonsten melde Dich noch mal !

Code:

Option Explicit

Private Sub CommandButton1_Click()
    Dim c As Long           'Spalten#
    Dim erg As Variant      'Ergebnis
    Dim sw As Boolean       'Schalter True=Komma voranstellen
    
    Const ZielAdr As String = "C12"                            '<---- Ziel-Adresse ggf anpassen
    
    With Worksheets("Info")
        For c = .Range("C7").Column To .Range("BT7").Column
            If .Cells(9, c) > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & .Cells(7, c) & " " & .Cells(8, c)
                sw = True
            End If
        Next c
    End With
    
    Worksheets("Details").Range(ZielAdr) = erg      ' Ergebnis nach Ziel-Adresse

End Sub
Gruß
Aloys

Geändert von aloys78 (07.01.2017 um 11:45 Uhr).
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.01.2017, 08:15   #5
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

so habe ich mir das vorgestellt.
Habe vielen Dank dafür!

Gruß
manega
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.01.2017, 09:08   #6
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

ich habe doch noch mal eine Bitte!
Durch diesen Code ergeben sich für mich völlig neue Möglichkeiten. Daher würde ich ihn gerne 3 Mal innerhalb einer Prozedur einsetzen.
Den Code mehrmals in das Modul einfügen und die Bereiche zu ändern scheint aber nicht auszureichen.
Jedenfalls meckert Excel rum, da ja alles mehrfach vorhanden ist.

Könntest du mir dabei bitte noch mal helfen?

Der Code soll mit den Bereichen so wie er ist bleiben. Es sollen jetzt aber noch 2 zusätzliche Bereiche eingefügt, bzw. in einem separatem Code angesprochen werden. Alles in den gleichen Tabellen!

Etwa so:
vorhandener Code:
Code:

    Const ZielAdr As String = "B3"                            '<---- Ziel-Adresse ggf anpassen
    
    With Worksheets("Info")
        For c = .Range("C7").Column To .Range("BT7").Column
            If .Cells(9, c) > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & .Cells(7, c) & " " & .Cells(8, c)
1. zusätzlicher Bereich:
Code:

    Const ZielAdr As String = "C3"                            '<---- Ziel-Adresse ggf anpassen
    
    With Worksheets("Info")
        For c = .Range("C3").Column To .Range("M3").Column
            If .Cells(5, c) > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & .Cells(3, c) & " " & .Cells(4, c)
2. zusätzlicher Bereich:
Code:

    Const ZielAdr As String = "B5"                            '<---- Ziel-Adresse ggf anpassen
    
    With Worksheets("Info")
        For c = .Range("N3").Column To .Range("BT3").Column
            If .Cells(5, c) > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & .Cells(3, c) & " " & .Cells(4, c)
Vielen Dank schon mal im Voraus.

Gruß
manega
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.01.2017, 10:56   #7
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

anbei mein Codevorschlag.

Beim 2. Block habe ich Zieladresse C3 in B4 geändert, da ansonsten das Ergebnis aus Block 1 überschrieben würde.

Wenn noch mehr Blöcke auf diese Art zu übertragen wären, dann würde ich den Code total überarbeiten; mE hat sich das aber bei 3 Blöcken nicht gelohnt.

Gruß
Aloys
Code:

Option Explicit

Private Sub CommandButton1_Click()
'Version V2 vom 09.01.2017
    Dim c As Long           'Spalten#
    Dim erg As Variant      'Ergebnis
    Dim sw As Boolean       'Schalter True=Komma voranstellen
    Dim ZielAdr As String
    
    ZielAdr = "B3"
    With Worksheets("Info")
        For c = .Range("C7").Column To .Range("BT7").Column
            If .Cells(9, c) > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & .Cells(7, c) & " " & .Cells(8, c)
                sw = True
            End If
        Next c
    End With
    Worksheets("Details").Range(ZielAdr) = erg      ' Ergebnis nach Ziel-Adresse


    ZielAdr = "B4"                                  ' Zieladresse C3 duch B4 ersetzt
    erg = "": sw = False
    With Worksheets("Info")
        For c = .Range("C3").Column To .Range("M3").Column
            If .Cells(5, c) > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & .Cells(3, c) & " " & .Cells(4, c)
                sw = True
            End If
        Next c
    End With
    Worksheets("Details").Range(ZielAdr) = erg      ' Ergebnis nach Ziel-Adresse

    
    ZielAdr = "B5"
    erg = "": sw = False
    With Worksheets("Info")
        For c = .Range("N3").Column To .Range("BT3").Column
            If .Cells(5, c) > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & .Cells(3, c) & " " & .Cells(4, c)
                sw = True
            End If
        Next c
    End With
    Worksheets("Details").Range(ZielAdr) = erg      ' Ergebnis nach Ziel-Adresse
End Sub
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.01.2017, 13:40   #8
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

funktioniert wieder einmal super.
Vielen Dank!
Ich hoffe, dass ich dich deswegen nicht noch mal beanspruchen muss!

Gruß
manega
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.01.2017, 23:30   #9
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

sorry das ich schon wieder störe, aber ich bekomme es alleine nicht hin!
Beim weiteren Bearbeiten meiner Datei bin ich auf ein Problem gestoßen, welches es nötig macht den Code den du mir geschrieben hast noch einmal zu ändern.
Hier noch mal der Code so wie er jetzt läuft:
Code:

' Code zur Darstellung der Variante, der Optionen und der Ausstattung
    Dim c As Long           'Spalten#
    Dim erg As Variant      'Ergebnis
    Dim sw As Boolean       'Schalter True=Komma voranstellen
    Dim ZielAdr As String
    
    ZielAdr = "G4" ' Optionen (Eintrag in Hilfszelle wegen Zeilenhöhenanpassung, wird per Formel übertragen)
    With Worksheets("Info")
        For c = .Range("C7").Column To .Range("BT7").Column
            If .Cells(9, c) > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & .Cells(7, c) & " " & .Cells(8, c)
                sw = True
            End If
        Next c
    End With
    Worksheets("Details").Range(ZielAdr) = erg      ' Ergebnis nach Ziel-Adresse


    ZielAdr = "C1" ' Variante
    erg = "": sw = False
    With Worksheets("Info")
        For c = .Range("C3").Column To .Range("AC3").Column
            If .Cells(5, c) > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & .Cells(3, c) & " " & .Cells(4, c)
                sw = True
            End If
        Next c
    End With
    Worksheets("Details").Range(ZielAdr) = erg      ' Ergebnis nach Ziel-Adresse

    
    ZielAdr = "G6" ' Ausstattung (Eintrag in Hilfszelle wegen Zeilenhöhenanpassung, wird per Formel übertragen)
    erg = "": sw = False
    With Worksheets("Info")
        For c = .Range("AD3").Column To .Range("BT3").Column
            If .Cells(5, c) > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & .Cells(3, c) & " " & .Cells(4, c)
                sw = True
            End If
        Next c
    End With
    Worksheets("Details").Range(ZielAdr) = erg      ' Ergebnis nach Ziel-Adresse
Demnach sind die Zeilen "If .Cells(5, c) > 0 Then" und "If .Cells(9, c) > 0 Then" die Auslöser für die Übertragung der Texte.
Wie müssten die Zeilen aussehen wenn diese Auslöser in Spalte B stehen? Für den 1. Teil von B302-B371, für den 2. Teil B374-B400, für den 3. Teil B401-443

Zusätzlich wäre es super, wenn du den Code nach einem ähnlichen Prinzip noch um einen Block erweitern könntest. Die Quell- und Zieltabellen sind identisch mit denen in den anderen Blöcken. Die Auslöser (also >0) stehen in Tabelle "Info" B10-B299. Der zu übertragende Text steht daneben in A10-A299. Also nur eine Zelle für den Text! Die Ausgabezelle für den Text ist in Tabelle "Details" in A1. Sollten nun 2 Textzellen aus der Quelltabelle übertragen werden, wäre es super, wenn sie in der Ausgabezelle durch das Wort "mit" verbunden werden würden. Sollte das nicht möglich oder zu umständlich sein, würde auch ein Komma reichen.


Vorab schon mal vielen Dank!

Gruß
manega

Geändert von manega (12.01.2017 um 01:24 Uhr). Grund: Nachtrag
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.01.2017, 07:38   #10
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

Zitat:

Wie müssten die Zeilen aussehen wenn diese Auslöser in Spalte B stehen?

Die zugehörigen Texte stehen dann wohl auch in Spalte A ?

Mein Vorschlag:
Lade mal eine Beispiel-Datei mit Ausgangsdaten und gewünschten Ergebnissen für alle 4 Fälle hoch.
Dann sehen wir weiter.

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.01.2017, 10:17   #11
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

du hast recht, es stehen alle Texte in Spalte A. Daran habe ich überhaupt nicht gedacht!
Die Datei kann ich auf Grund ihrer Größe nicht direkt hochladen. Daher hier der Download link:

https://www.dropbox.com/s/33n7odwf5k...%201.xlsm?dl=0

Die Datei enthält das komplette Makro in dem auch der Code enthalten ist. Das Makro befindet sich in Modul26 und wird durch das Anklicken des Button "Details" in Tabelle "Info" ausgelöst.
Der zusätzlich gewünschte Code wird bisher durch das Einfügen einer Formel zur Darstellung eines Textes in die Zielzelle realisiert. Der Nachteil dabei ist, dass immer nur ein Text, und dann auch immer der am weitesten unten stehende Text dargestellt werden kann.

Vielen Dank und Gruß
manega
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.01.2017, 11:54   #12
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

ich brauche nur eine Datei mit den Tabellenblättern Info und Details, ggf nur mit ein paar Bespielldaten für Quelle und Ergebnis, möglichst ohne jeden Code; der eine interessiert mich nicht, der andere wird sowieso total verändert.

Diese Datei bitte dann mit Boardmitteln des Forums zur Verfügung stellen.

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.01.2017, 13:48   #13
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

hier die abgespeckte Version! Leider ist nur noch die Tabelle "Details" übrig geblieben!

Für Tabelle "Info" gilt folgendes:
Der Text steht in jedem Fall in Spalte A, die dazugehörige Zahl wird in Spalte B eingetragen.
A10 - A299 und B10 - B299 ist der gewünschte zusätzliche Bereich. Text bitte in Tabelle "Details" nach G1
A302 - A371 und B302 - B371 ist der ursprünglich 1. Block. Text bitte in Tabelle "Details" nach G4
A374 - A400 und B374 - B400 ist der ursprünglich 2. Block. Text bitte in Tabelle "Details" nach C1 - wirklich C1!!!
A401 - A443 und B401 - B443 ist der ursprünglich 3. Block. Text bitte in Tabelle "Details" nach G6



Gruß
manega
Angehängte Dateien
Dateityp: xlsm Beispieldatei 1.xlsm (151,5 KB, 2x aufgerufen)
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.01.2017, 17:34   #14
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

Zitat:

Leider ist nur noch die Tabelle "Details" übrig geblieben!

Witzbold !!!
Die Tabelle Info ist die Wichtigere.
Eine Beispieldatei mit Ausgangsdaten sowie einer Ergebnisdarstellung bereit zu stellen, ist für beide Seiten von Interesse.
Für den Helfer ist eine zusätzliche Veranschaulichung der Aufgabenstellung und eine Grundlage für den Test.
Für Dich hat es Vorteile, wenn die Lösung auch mit Deinen Daten getestet wurde.

Im vorliegenden Fall überlasse ich Dir den Test.

Dass es bei den Ziel-Adressen C1 und G1 zu Überlappungen kommen könnte, ist Dir bewußt ?

Anbei mein Codevorschlag:
Code:

Option Explicit

Private Sub CommandButton1_Click()
'Version V3 vom 12.01.2017
    Dim r As Long, r1 As Long, r2 As Long   'Zeilen# Quellbereich
    Dim erg As Variant                      'Ergebnis
    Dim sw As Boolean                       'Schalter True=Komma voranstellen
    Dim arrQAdr()                           'Adressbereiche Quelldaten
    Dim arrZAdr()                           'Zieladresse für Ergebnis
    Dim a As Long                           'Index Array
    Dim ZielAdr As String                   'die jeweilieg Ziel-Adresse
    Dim QBereich As Range                   'der jeweilieg Quell-Bereich
    Dim rng As Range                        'Zelle im Quellbereich
    
    arrQAdr = Array("B10:B299", "B302:B371", "B374:B400", "B401:B443")      'Adressen der einzelnen Quell-Bereiche
    arrZAdr = Array("G1", "G4", "C1", "G6")                                 'korrespondierende Ziel-Adressen
            
    For a = LBound(arrQAdr) To UBound(arrQAdr)
        sw = False
        erg = ""
        ZielAdr = arrZAdr(a)
        Set QBereich = Worksheets("Info").Range(arrQAdr(a))
        For Each rng In QBereich.Cells
            If rng.Value > 0 Then
                erg = erg & IIf(sw = True, ", ", "") & rng.Offset(0, -1)
                sw = True
            End If
        Next rng
        Worksheets("Details").Range(ZielAdr) = erg      ' Ergebnis nach Ziel-Adresse
    Next a
End Sub
Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.01.2017, 08:06   #15
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

habe tausend Dank für deine Hilfe und Geduld!
Wie immer hat dein Code auf Anhieb funktioniert.

Mit der Beispieldatei wollte ich dich nicht ärgern. Aber die max. Größe ist nun mal auf 195 kB begrenzt. Die habe ich letztlich nur erreicht, als ich die Tabelle Info entfernt habe. Und dort waren nur in 2 Spalten über 4 Zeilen Einträge vorhanden.
Daher hatte ich dir die Datei zum Download angeboten.
Also, sorry und nochmals vielen Dank!

Gruß
manega
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 01:19 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.