title image


Smiley Ergänzung : Währungsformat und feste Werte anstatt Summenfunktion
Hey Diavolos,



hier die gewünschten Ergänzungen :

      

Sub BegriffSuchenUndSpalteEinfügen()

    Dim Suchbegriff()

    Suchbegriff = Array("Haus", "Wohnung", "Katze", "Miete") 'Suchbegriffe hier eingeben

    On Error Resume Next

    For t = 0 To UBound(Suchbegriff)

        Spalte = WorksheetFunction.Match(Suchbegriff(t),[1:1], 0)

        If Spalte <> "" Then t = UBound(Suchbegriff)

    Next

    If Spalte <> "" Then

        Columns(Spalte).Insert Shift:=xlToRight

        Cells(1, Spalte) = "Gesamt" 'Hier die neue Überschrift eingeben

        ls = Cells(1, Spalte).End(xlToRight).Column 'LetzteSpalte

        lz = Cells(1, Spalte).CurrentRegion.Rows.Count 'LetzteZeile

        For Zeile = 2 To lz

            Cells(Zeile, Spalte) = Application.Sum(Range(Cells(Zeile, Spalte + 1), _

                Cells(Zeile, ls)))

        Next

        'Alternativ : Die Summe als Funktion einfügen :

        'Range(Cells(2, spalte), Cells(lz, spalte)).Formula = _

            "=sum(RC[1]:RC[" & ls - spalte & "])"

        Range(Cells(2, Spalte), Cells(lz, ls)).Style = "Currency"

    Else

        MsgBox "Keiner der Suchbegriffe wurde in Zeile 1 gefunden !"

    End If

End Sub 

Grüße, NoNet

  1,2,3 - kleine Excelei :   Infos + Anmeldung zum Jährlichen Exceltreffen



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: