title image


Smiley Das kann ich nicht verantworten. Hier noch eine kleine Krücke! ;-)






Sub BegriffSuchenUndSpalteEinfügen()

    Dim Suchbegriff()

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

    Suchbegriff2 = "PLAKAT"

    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

    Spalte2 = WorksheetFunction.Match(Suchbegriff2,[1:1], 0)

    Range(Cells(2, Spalte2), Cells(lz, Spalte2)).ClearContents

    ActiveSheet.Protect "DD" 'hier Passwort anpassen

    ActiveWorkbook.Save

End Sub







Code eingefügt mit Syntaxhighlighter 4.0




Gruß,



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: