Wenn Dann Funktion

Hallo,
ich habe ein Problem bei dem ich leider nicht weiterkomme, daher meine Frage an die Profis.
Ich möchte per Makro folgendes ausführen:
Spalte B - C - und D enthalten Text in C und D unter anderem das Wort 'Zubehör'
In Spalte E sollen folgende Werte stehen:
Wenn Spalte B = Text und C und D ist leer dann soll in E der Text von B stehen
Wenn Spalte B = Text und C = Text und D ist leer dann soll in E der Text von C stehen
ist der Text in C aber 'Zubehör' dann soll in E der Text von B + C stehen
Wenn Spalte B = Text und C = Text und D = Text dann soll in E der Text von D stehen
ist der Text in D aber 'Zubehör' dann soll in E der Text von C + D stehen
Userbild

Ich hoffe ich habe es einigermaßen verständlich erklärt - ich habe es mal als Bild mit hochgeladen - weil ich Blick gerade überhaupt nicht mehr durch.
Es wäre nett wenn Ihr mal nen Blick riskiert.
Gruß
Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Ergänzen() Const strC As String = "Zubehör" Dim l As Long With ActiveSheet For l = 1 To .UsedRange.Rows.Count If Len(Trim$(.Cells(l, 2).Value)) > 0 Then If Len(Trim$(.Cells(l, 3).Value)) > 0 Then If Len(Trim$(.Cells(l, 4).Value)) > 0 Then If Trim$(.Cells(l, 4).Value) = strC Then .Cells(l, 5).Value = Trim$(.Cells(l, 3).Value) & " " & _ Trim$(.Cells(l, 4).Value) Else .Cells(l, 5).Value = Trim$(.Cells(l, 4).Value) End If Else .Cells(l, 5).Value = Trim$(.Cells(l, 2).Value) & " " & _ Trim$(.Cells(l, 3).Value) End If Else If Len(Trim$(.Cells(l, 4).Value)) = 0 Then .Cells(l, 5).Value = Trim$(.Cells(l, 2).Value) Else .Cells(l, 5).Value = "Fehler: Spalte C ist leer, aber Spalte D nicht!" End If End If End If Next End With End Sub

Hallo,
meinst Du so?

Sub test()
Dim MeArWerte(), MeArAusgabe()
Dim A As Long
Dim LRowMax As Long

With Sheets("Tabelle1")
     LRowMax = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count)
    
    
    'es wird davon ausgegangen, in Zeile 1 ist eine Überschrift 
    MeArWerte = .Range("B2:D" & LRowMax).Value2
    Redim Preserve MeArAusgabe(1 To Ubound(MeArWerte), 1 To 1)
    
    For A = 1 To Ubound(MeArWerte)
        If MeArWerte(A, 1) <> "" Then
            'Wenn Spalte B = Text und C und D ist leer dann soll in E der Text von B stehen 
            If MeArWerte(A, 1) <> "" And MeArWerte(A, 2) = "" And MeArWerte(A, 3) = "" Then
                MeArAusgabe(A, 1) = MeArWerte(A, 2)
            
            'Wenn Spalte B = Text und C = Text und D ist leer dann soll in E der Text von C stehen 
            'ist der Text in C aber 'Zubehör' dann soll in E der Text von B + C stehen 
            ElseIf MeArWerte(A, 1) <> "" And MeArWerte(A, 2) <> "" And MeArWerte(A, 3) = "" Then
                
                If MeArWerte(A, 2) = "Zubehör" Then
                 MeArAusgabe(A, 1) = MeArWerte(A, 1) & " " & MeArWerte(A, 2) 'B + C 
                Else
                 MeArAusgabe(A, 1) = MeArWerte(A, 2)
                End If
           
            'Wenn Spalte B = Text und C = Text und D = Text dann soll in E der Text von D stehen 
            'ist der Text in D aber 'Zubehör' dann soll in E der Text von C + D stehen 
            ElseIf MeArWerte(A, 1) <> "" And MeArWerte(A, 2) <> "" And MeArWerte(A, 3) <> "" Then
               
                If MeArWerte(A, 3) = "Zubehör" Then
                 MeArAusgabe(A, 1) = MeArWerte(A, 2) & " " & MeArWerte(A, 3) 'C + D 
                Else
                 MeArAusgabe(A, 1) = MeArWerte(A, 2) 'D 
                End If
            
            End If
         End If
    Next A
    
    .Range("E2").Resize(Ubound(MeArAusgabe)) = MeArAusgabe
End With
End Sub

Gruß Tino

Sub test() Dim MeArWerte(), MeArAusgabe() Dim A As Long Dim LRowMax As Long With Sheets("Tabelle1") LRowMax = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) 'es wird davon ausgegangen, in Zeile 1 ist eine Überschrift MeArWerte = .Range("B2:D" & LRowMax).Value2 Redim Preserve MeArAusgabe(1 To Ubound(MeArWerte), 1 To 1) For A = 1 To Ubound(MeArWerte) 'Wenn Spalte B = Text If MeArWerte(A, 1) <> "" Then 'Wenn C und D ist leer dann soll in E der Text von B stehen If MeArWerte(A, 2) = "" And MeArWerte(A, 3) = "" Then MeArAusgabe(A, 1) = MeArWerte(A, 2) 'Wenn C = Text und D ist leer dann soll in E der Text von C stehen 'ist der Text in C aber 'Zubehör' dann soll in E der Text von B + C stehen ElseIf MeArWerte(A, 2) <> "" And MeArWerte(A, 3) = "" Then If MeArWerte(A, 2) = "Zubehör" Then MeArAusgabe(A, 1) = MeArWerte(A, 1) & " " & MeArWerte(A, 2) 'B + C Else MeArAusgabe(A, 1) = MeArWerte(A, 2) End If 'Wenn C = Text und D = Text dann soll in E der Text von D stehen 'ist der Text in D aber 'Zubehör' dann soll in E der Text von C + D stehen ElseIf MeArWerte(A, 2) <> "" And MeArWerte(A, 3) <> "" Then If MeArWerte(A, 3) = "Zubehör" Then MeArAusgabe(A, 1) = MeArWerte(A, 2) & " " & MeArWerte(A, 3) 'C + D Else MeArAusgabe(A, 1) = MeArWerte(A, 2) 'D End If End If End If Next A .Range("E2").Resize(Ubound(MeArAusgabe)) = MeArAusgabe End With End Sub

Sub Verbinden_C_D() Dim A As Long Dim LRowMax As Long Dim MeArWerte(), MeArAusgabe() With Sheets("Tabelle1") LRowMax = IIf(IsEmpty(.Cells(.Rows.Count, 3)), .Cells(.Rows.Count, 4).End(xlUp).Row, .Rows.Count) 'es wird davon ausgegangen, in Zeile 1 ist eine Überschrift MeArWerte = .Range("C1:D" & LRowMax).Value2 Redim Preserve MeArAusgabe(1 To Ubound(MeArWerte), 1 To 1) For A = 1 To Ubound(MeArWerte) If InStr("RAM;+R;+R9 (Double Layer);+RW;-R;-R9 (Double Layer)", MeArWerte(A, 2)) > 0 Then MeArAusgabe(A, 1) = MeArWerte(A, 1) & " " & MeArWerte(A, 2) End If Next A .Range("D1").Resize(Ubound(MeArAusgabe)) = MeArAusgabe End With End Sub

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

335 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wenn Dann Funktion

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

335 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread