title image


Smiley Re: Ah Stop
Hallo,



so langsam wird es ein Projekt und keine Forumsfrage mehr. Hier mein Vorschlag. Für einzelne neue Fragen mache bitte einen neuen Thread auf.







Sub BegriffSuchenUndSpalteEinfügen()

    Dim Suchbegriff()

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

    Suchbegriff2 = "MDEG"

    Suchbegriff3 = "Produkt"

    Suchbegriff4 = "Webut"

    ActiveWindow.FreezePanes = False

    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

    If[1:1].Find(Suchbegriff3) Is Nothing Then

        Spalte3 =[1:1].Find(Suchbegriff4).Column

    Else

        Spalte3 =[1:1].Find(Suchbegriff3).Column

    End If

    Cells(2, Spalte3 + 1).Select

    ActiveWindow.FreezePanes = True

    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: