Makros unter Excel

  • Hat / Oder haben hier welche tiefer gehende Kenntnisse von Makros in Excel?
    Ich bastele hier schon seit einiger Zeit an einem Makro der mich noch um die Ecke bringt.

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk




  • ---------- 13. Juni 2017, 19:54 ----------


    Ich habe da ein Makro gefunden, der macht eigentlich genau das was ich möchte. Vor Ausführung des eigentlichen Makros speichert er die Datei. Davon bis zu 5 Stck, dann überschreibt dieser die alten. Läuft soweit gut. Leider speichert er dieser aber auf den Desktop ab. Ich versuche nun schon den ganzen Tag mir diesen anzupassen. Leider bekomme ich es nicht hin. Viel Ahnung habe ich leider sowieso nicht. Was möchte ich gerne? Ich hätte gerne, dass im selben Ordner, wie die Ursprungsdatei ein Ordner „Backup“ mit dem selben Namen wie die Ursprungsdatei gebildet wird und darunter die 5 Backups mit dem selben Namen wie die Ursprungsdatei + Backup + Datum-Uhrzeit-Sekunden gebildet werden. Die Exceldatei ist ein Basisdatei die immer als Blankette verwendet und dann unter anderen Namen abgespeichert wir. Daher muss auch dieser Name sich an der Bezugsdatei anpassen.


    Datei XYZ
    Datei 123
    Backup Datei 123 / Backup Datei 123 – 20170612213915 (1 bis 5)
    Datei ABC

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk

  • Das bestimmt doch die Zeile backuppfad. Mit Application.ActiveWorkbook.Path bestimmst du den aktuellen Ordner deiner geöffneten Datei, mit Application.ActiveWorkbook.FullName den Pfad inkl Dateiname. Das haust du dir in nen Dim und kannst es danach benutzen.
    Schreib grad nur vom Handy, wenns bis morgen nicht klappt gibts mehr.

  • BackupPfad = Application.ThisWorkbook.Path & "\Backup\"


    Allerdings muss das Verzeichnis Backup dann existieren. Sonst gibt es einen Fehler. Also am besten anlegen wenn nicht vorhanden.


    ---------- 13. Juni 2017, 20:56 ----------


    Hier mal auf die schnelle:

  • WOW


    SUPER


    Da treibe ich mich seit einer Wochen in den Excel Foren rum und wo bekomme ich die Antwort.
    In das Makro bildet sogar ein eigenes Unterverzeichnis. Das löst alle Problem....


    DANKE


    Keine Bange. Kommen bestimmt noch ein paar Fragen :D


    ---------- 13. Juni 2017, 22:00 ----------


    Auch Dir meinen Dank dermarc.
    Du bekommst noch Deine Chance - sei dir sicher ;)


    ---------- 13. Juni 2017, 23:09 ----------


    Ich möchte Euch nicht enttäuschen!
    Einen habe ich (vorerst) nocht.


    Ich habe hier ein Codeschnipsel

    Das ist das Ende eines Codes das Rechenoperanden quer durch die Excel Tabelle verteil.
    Dann färbt der Code die Zeile grau und gibt an das die Schrift in der Zeile fett werden soll.
    Dann springt der Code in die betreffende Zelle der Spalte "D" und setzt ein Sternchen (für späteres Autofiltern, dann springt der Code in seine Soll-Position 4 nach rechts und 2 runter.


    Ich hätte noch gerne, dass er nach den Sternchen setzen, noch in den 2 rechts daneben befindlichen aber schon beschrifteten Zellen noch das Wörtchen "Summe (Leerzeichen)" davor schreibt und dann hiernach 2 nach rechts und 2 runter.


    Ich habe da schon was gebastelt. Dooferweise ende ich immer überall nur nicht genau da wo ich hin will.:-(


    Nicht das Ihr Euch ausgenutzt fühlt, aber ich kann einfach nicht widerstehen..........

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk


  • Ich hätte noch gerne, dass er nach den Sternchen setzen, noch in den 2 rechts daneben befindlichen aber schon beschrifteten Zellen noch das Wörtchen "Summe (Leerzeichen)" davor schreibt und dann hiernach 2 nach rechts und 2 runter.

    Auf die Schnelle, meinst Du in etwa so?
    Wobei i,5 und i,6 einen String bilden, soll das wirklich so sein?


    #################################################
    Sub test()
    Dim i&
    i = ActiveCell.Row
    Cells(i, 4).FormulaR1C1 = "*" 'Sternchen in Spalte D
    Cells(i, 5).Value = "Summe: " & Cells(i, 5).Value 'Spalte E
    Cells(i, 6).Value = "Summe: " & Cells(i, 6).Value 'Spalte F
    Cells(i + 2, 8).Select 'zwei runter, zwei nach rechts
    End Sub
    #################################################

    ---
    It's not the hammer, it is the way you hit.

  • Hi Trekki
    Super - macht genau was ich wollte. Danke
    String ?? verstehe ich so, da ich da Text drin habe - ist das was Du meinst?

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk

  • Ja genau das meinte ich, weiss ja nicht, ob du mit cells i,5 und i,6 später mal noch rechnen möchtest/musst.
    Achja und falls das Makro mehrfach läuft und da schon 'Summe: ' drinnen steht, dann tausch die zwei Zeilen gegen diese:


    If Not Split(Cells(i, 5))(0) = "Summe:" Then Cells(i, 5).Value = "Summe: " & Cells(i, 5).Value
    If Not Split(Cells(i, 6))(0) = "Summe:" Then Cells(i, 6).Value = "Summe: " & Cells(i, 6).Value


    ... sonst steht da dann Summe: Summe: Summe: 123 ;)

    ---
    It's not the hammer, it is the way you hit.

  • Super - dass hatte mich beim rumprobieren schon ganz verrückt gemacht.
    Einen Fehler habe ich aber nun irgendwie nach dem ich alle Makros in einzelnen Mappen probiert hatte und nun zusammengefügt habe.


    Planmäßig soll das strg. "s" Makro unter anderen die Schrift fett machen.
    Jetzt geht das nicht mehr.
    Ich habe das Makro mehrfach kopiert.
    Es macht die Schrift in der Bezugsspalte einfach nicht fett.
    Das selbe Makro in einer eigenen Mappe schon.
    Wie kommt das?

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk

  • Möglicherweise irgendwas mit ThisWorkbook, ActiveWorkbook oder den entsprechenden Sheets.
    In Zeile 85 benimst du eine ganze Zeile (Spalte find ich nix?), allerdings immer über den Bezug Activecell, ohne Blatt oder Dateiname voran.


    Wenn Du mal eine kleine, sinngemäße Beispieltabelle hättest, was wo wie soll, wäre es einfacher als mit dem Recorderquarki, weil man nicht weiss, wo Activecell startet bzw. die selection liegt ;)


    ---------- 14. Juni 2017, 19:48 ----------


    Ich hatte mal deinen Code laufen lassen und gekuckt was passiert ab dem Part strg+s,
    wäre dies in etwa das, wo du hin möchtest (Autosumme aller belegter Zellen von A1 bis Spalte R1) ?


    Code
    1. Sub mark() Dim r As Long, c As Integer r = Cells(Rows.Count, 1).End(xlUp).Row 'Debug.Print r 'r=Zeilenzähler With Worksheets("Tabelle1") For c = 1 To 19 'Spaltenschleife .Cells(r + 2, c).Formula = WorksheetFunction.Sum(.Range(.Cells(1, c), .Cells(r, c))) Next .Range(.Cells(r + 2, 1), .Cells(r + 2, 19)).Font.Bold = True .Cells(r + 2, 3) = "" .Cells(r + 2, 4) = "*" .Cells(r + 2, 7) = "" If Not Split(.Cells(r + 2, 5))(0) = "Summe:" Then .Cells(r + 2, 5).Value = "Summe: " & .Cells(r + 2, 5).Value If Not Split(.Cells(r + 2, 6))(0) = "Summe:" Then .Cells(r + 2, 6).Value = "Summe: " & .Cells(r + 2, 6).Value End WithEnd Sub

    ??????????


    nochmal ohne Formatierung



    #######################################################################################


    Sub mark()
    Dim r As Long, c As Integer
    r = Cells(Rows.Count, 1).End(xlUp).Row
    'Debug.Print r 'r=Zeilenzähler
    With Worksheets("Tabelle1")
    For c = 1 To 19 'Spaltenschleife
    .Cells(r + 2, c).Formula = WorksheetFunction.Sum(.Range(.Cells(1, c), .Cells(r, c)))
    Next
    .Range(.Cells(r + 2, 1), .Cells(r + 2, 19)).Font.Bold = True
    .Cells(r + 2, 3) = ""
    .Cells(r + 2, 4) = "*"
    .Cells(r + 2, 7) = ""
    If Not Split(.Cells(r + 2, 5))(0) = "Summe:" Then .Cells(r + 2, 5).Value = "Summe: " & .Cells(r + 2, 5).Value
    If Not Split(.Cells(r + 2, 6))(0) = "Summe:" Then .Cells(r + 2, 6).Value = "Summe: " & .Cells(r + 2, 6).Value
    End With
    End Sub
    ########################################################################################

    ---
    It's not the hammer, it is the way you hit.

  • hmmm
    Ich habe Dein Makro mal übernommen und erhalte nur Laufzeitfehler 9.
    Daher weiß ich nicht was es macht.
    Ich überlege mir mal wie ich hier die Tabelle rein kriege.
    Am liebsten wurde ich die Exceldatei reinkopieren :-)


    ---------- 14. Juni 2017, 20:49 ----------


    Ich hoffe das hilft weiter.
    Excel bekomme ich leider nicht hochgeladen :-)
    Die grauen Querstreifen (Zeilen) werden nicht fett geschrieben nachdem die Makros nun alle in einer Datei sind.

    Dateien

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk

  • In welcher Zeile?


    Nochmal mit r im with-Bereich und font.bold auskommentiert, da ich xl2000 habe ;)


    Sub mark()
    Dim r As Long, c As Integer

    With Worksheets("Tabelle1")
    r = .Cells(Rows.Count, 1).End(xlUp).Row ': Debug.Print r ' letzte belegte Zeile
    For c = 1 To 19 'Spaltenschleife
    .Cells(r + 2, c).Formula = WorksheetFunction.Sum(.Range(.Cells(1, c), .Cells(r, c)))
    Next
    '.Range(.Cells(r + 2, 1), .Cells(r + 2, 19)).Font.Bold = True
    .Cells(r + 2, 3) = ""
    .Cells(r + 2, 4) = "*"
    .Cells(r + 2, 7) = ""
    If Not Split(.Cells(r + 2, 5))(0) = "Summe:" Then .Cells(r + 2, 5).Value = "Summe: " & .Cells(r + 2, 5).Value
    If Not Split(.Cells(r + 2, 6))(0) = "Summe:" Then .Cells(r + 2, 6).Value = "Summe: " & .Cells(r + 2, 6).Value
    End With
    End Sub

    ---
    It's not the hammer, it is the way you hit.

  • In welcher Zeile?
    Laufzeutfehler 9 - immer noch und wenn ich debugge ist folgendes gelb
    With Worksheets("Tabelle1")

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk

  • wie heisst denn deine tabelle?
    Es muss lauten: with worksheets("DeinTabellenname"),


    wobei:


    da ich nur xl2k habe und nicht weiss wie die aktuellen Versionen sind, kanns auch ein Versionsfehler sein?


    ---------- 14. Juni 2017, 21:37 ----------


    Nochwas, hab mal deine pdf angeschaut, du möchtest immer ab activecell (deine Cursorposition) die einzelnen Losbereichssummen 01 bis 0x aufsummieren?
    Wenn du mit der Krücke (activecell manuell setzen) leben kannst, probier ichs mal, die ganze Tabelle auf einen Hieb automatisch trau' ich mir nicht zu, ginge sicher mit arrays,
    aber hab >10 jahre nix mit vba gemacht.

    ---
    It's not the hammer, it is the way you hit.

  • hmmmm
    sind
    das

    Code
    1. r = .Cells(Rows.Count, 1).End(xlUp).Row ': Debug.Print r ' letzte belegte Zeile


    und das



    Code
    1. '.Range(.Cells(r + 2, 1), .Cells(r + 2, 19)).Font.Bold = True

    sind das wirklich Hochkomma?
    Die werden doch für Erläuterungen eingefügt und der Text danach ist kein Teil des Makros - oder?


    ---------- 14. Juni 2017, 21:46 ----------


    Ach Ja
    Das Tabellenblatt heißt [definition=41,0]LV[/definition]
    So hatte ich das geändert

    Code
    1. With Worksheets("LV")

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk

  • Ja das sind hochkommata, damit kann Code auskommentiert werden, also quasi ausgeschaltet oder eben für 'echte' Erläuterungen/Kommentare benutzt werden,
    die erste Zeile, nach end(xlup).row --- das 'debug.print und 'letzte belegte zeile das ist quasi entschärft (kannste auch löschen)


    die Zeile mit font.bold=true hatte ich auskommentiert wg. evtl. Versionsunterschiede zur Fettschrift zw. meinem Excel (2000) und deinem (aktuelleren) Excel

    ---
    It's not the hammer, it is the way you hit.


  • was soll ich sagen?
    Ich weiß nicht was der Code machen soll, aber er läuft nicht bei mir.

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk

  • Mal folgender Test, probiere mal das Codesnippet:


    ###################
    Sub asdf()
    Dim r As Long
    With Worksheets("[definition=41,0]LV[/definition]")
    r = .Cells(Rows.Count, 2).End(xlUp).Row 'letzte belegte Zeilennummer in Spalte 2
    Debug.Print r ' Ausgabe Wert der Variablen r im Direktfenster
    Debug.Print .Cells(r, 2).Font.Bold 'Prüfen ob Fettschrift in Zeile r, Spalte 2 im Direktfenster
    End With
    End Sub
    ####################


    ... ergibt bei meiner Testmappe im Direktfenster folgende Ausgabe:


    #######
    13 ' letzte Zeilennummer in Spalte 2 (B)
    Falsch ' --> keine Fettschrift in B13, Ausgabe wäre Wahr wenn B13 Fett
    #######


    oder mal ganz ohne alles, einfach mal die jeweilige Zeile mit ? eingeben im Direktfenster und abentern:


    #######################
    ?worksheets("[definition=41,0]LV[/definition]").Cells(Rows.Count, 2).End(xlUp).Row '& Enter
    13
    ?now '& Enter
    14.06.2017 23:55:39
    ?split("test eins zwei")(0) '& Enter
    test
    ?split("test eins zwei")(1) 'usw
    eins
    ?split("test eins zwei")(2)
    zwei
    #######################


    Am besten man gewöhnt sich an Direktfenster und Lokalfenster, da kann man vieles abprüfen,
    blende dir das unter 'Ansicht' ein, hilft viel zum Verständnis und bei der Fehlersuche.


    Eigentlich wäre noch viel zu fragen/sagen, aber ich muss erstmal in die Falle.
    Nur soviel, halbwegs die Grundlagen müssen verstanden sein, dann machts auch Spaß, selbst weiterzuentwickeln,
    sofern Zeit & Nerven vorhanden ;)

    ---
    It's not the hammer, it is the way you hit.

  • Ich versuche gleich Mal zu ergründen was Du mir versucht hast mitzuteilen :-)


    Wenn ich es richtig sehe, fängt in diesen Teilschnipsel doch mein Problem an:

    Code
    1. ActiveCell.Rows("1:1").EntireRow.Select 'ab hier Zeile, markieren, grau, dicke Schrift
    2. With Selection.Interior 'ist das Problem evtl. das "Selektion", wird im I-Net vor gewarnt
    3. .Pattern = xlSolid
    4. .PatternColorIndex = xlAutomatic
    5. .ThemeColor = xlThemeColorDark1
    6. .TintAndShade = -4.99893185216834E-02
    7. .PatternTintAndShade = 0
    8. End With

    Da drüber und da drunter läuft alles.
    Im I-Net lese ich immer wieder dass "Selektion" ein Problem sein kann.
    Kann das sein?

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk

  • Versuch mal das Snippet ohne Selection bzw. wenn wieder Fehlermeldung was sagt diese?


    Achja, kopiere sub x() mal in ein Modul, parke deinen Cursor irgendwo zwischen sub x() und end sub
    und drücke F8, damit kannst Du im Einzelschritt Zeile für Zeile durchgehen und siehst wo er ggf. aussteigen will.
    Einzelschritt-Modus beenden mit Menü Ausführen > Zurücksetzen oder ganz normal immer weiter F8 bis end sub erreicht ist.


    Sub x()
    With ActiveCell.EntireRow.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    '.ThemeColor = xlThemeColorDark1
    '.TintAndShade = -4.99893185216834E-02
    '.PatternTintAndShade = 0
    End With
    End Sub

    ---
    It's not the hammer, it is the way you hit.

  • F8 ist sone Sache.
    Dann geht bei mir ein Popup auf damit ich telefonieren kann :-(


    Aber ich habe rausbekommen warum die Schrift mal fett, mal nicht fett wurde.
    Der Grund ist aber zu peinlich.
    Offenbar waren die Zeilen schon auf fett voreingestellt.
    Jetzt versuche ich mal Deinen Code nochmal.



    ---------- 15. Juni 2017, 14:48 ----------


    Ich habe die beiden nebeneinander ausgetauscht.
    Passiert nichts.

    Code
    1. With ActiveCell.EntireRow.Interior 'zu Testzwecke eingefügt ' With Selection.Interior


    Echt ärgerlich.
    Das Ding funzt jetzt über mehrere Tabellenblätter und verschiedenste WENN..blablabla. SVERWEISE, VVERWEISE.
    Nur in einem Tabellenblatt werden die Titelsummen nicht fett - mist.



    ---------- 15. Juni 2017, 14:56 ----------


    So, ich habe jetzt ein aufgenommenes Makro einfach reinkopiert. 96-98
    Jetzt läuft es offenbar.
    Blitzt und blinkt leider.
    Scheinbar alles nicht optimal.

    Code
    1. Sub Titelsummen()'' Titelsummen bilden, kopieren, Spalte eingrauen+Dickschrift,SternchenDim SavedBook As String ' ab hier: vorgeschaltete Sicherheitskopeierstellung, falls ein Makro versehentlich aktiviert wird.Const MaxBooks = 5Dim I As IntegerDim BackupPfad As StringDim KillBook As StringApplication.ScreenUpdating = FalseApplication.DisplayAlerts = False DateiName = ThisWorkbook.NameIf InStr(DateiName, ".") > 0 ThenDateiName = Left(DateiName, InStr(DateiName, ".") - 1)End IfBackupPfad = ThisWorkbook.Path & "\Backup " & DateiNameIf Dir(BackupPfad, vbDirectory) = "" ThenMkDir (BackupPfad)End IfBackupPfad = BackupPfad & "\"SavedBook = BackupPfad & "Backup " & DateiName & " - *"KillBook = "Backup " & DateiName & " - 99999999999999.xlsm"I = 0SavedBook = Dir(SavedBook)While SavedBook <> "" And I < MaxBooksIf KillBook > SavedBook ThenKillBook = SavedBookEnd IfI = I + 1SavedBook = DirWendIf I = MaxBooks ThenKill BackupPfad & KillBookEnd IfWith ActiveWorkbook.SaveCopyAs BackupPfad & "Backup " & DateiName & " - " & _Format(Now(), "yyyymmddhhnnss") & ".xlsm"End WithApplication.DisplayAlerts = TrueApplication.ScreenUpdating = True' Tastenkombination: Strg+s'ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Offset(0, 8).Range("A1").Select ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle ActiveCell.Offset(1, 0).Resize(2).ClearContents ActiveCell.Rows("1:1").EntireRow.Select 'ab hier Zeile, markieren, grau, dicke Schrift ' With ActiveCell.EntireRow.Interior 'zu Testzwecke eingefügt With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -4.99893185216834E-02 .PatternTintAndShade = 0 End With I = ActiveCell.Row Cells(I, 4).FormulaR1C1 = "*" 'Sternchen in Spalte D ActiveCell.Rows("1:1").EntireRow.Select 'ab hier Zeile fett Selection.Font.Bold = True ActiveCell.Offset(0, 3).Range("A1").Select If Not Split(Cells(I, 5))(0) = "Summe:" Then Cells(I, 5).Value = "Summe: " & Cells(I, 5).Value 'Spalte E ist die fünfte Spalte von links If Not Split(Cells(I, 6))(0) = "Summe:" Then Cells(I, 6).Value = "Summe: " & Cells(I, 6).Value 'Spalte Fist die sechste Spalte von links Cells(I + 1, 4).Select 'ein runter, null nach rechts Cells(I + 1, 4).FormulaR1C1 = "." 'ein runter, null nach rechts, einfügen "." damit der Autofilter nicht in der ersten Leerzelle hängen bleibt Cells(I + 2, 4).FormulaR1C1 = "." 'wie vor Cells(I + 2, 8).Select 'null runter, zwei nach rechtsEnd Sub


    Geht der folgende code (1-3) zufällig nur bis zur Spalte Z??
    Ich habe 6-8 versucht zuzufügen, der landet aber immer in Spalte Z anstelle in AB.





    Code
    1. ActiveCell.Offset(0, 1).Range("A1").Select
    2. ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-1, 0).End(xlUp), ActiveCell.Offset(-1, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle
    3. ActiveCell.Offset(1, 0).Resize(2).ClearContents
    4. ActiveCell.Offset(0, 1).Range("A1").Select
    5. ActiveCell.Formula = "=SUM(" & Range(ActiveCell.Offset(-3, 0).End(xlUp), ActiveCell.Offset(-3, 0)).Address & ")" 'dieser Teil gilt nur für die gemarkerte Zelle
    6. ActiveCell.Offset(1, 0).Resize(2).ClearContents


    Ich habe:


    ---------- 15. Juni 2017, 23:55 ----------


    Juhuuu
    Ich habe das Dinf (fast) so wie ich es haben will.
    Jetzt noch morgen ein paar Tricks überlegen wie Zeilen die wo keine Auswertbaren Passagen drin sind ausgeblendet werden und dann ist es geschafft.
    Das ganze soll eine Kalkulationssoftware werden mit Verknüpfung zu unserem Kypernetischen Nachkalkulationssystem.
    Das konnte bisher keiner liefern.



    Ich danke Euch noch einmal für Eure Unterstützung.

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk

  • [...]


    Jetzt noch morgen ein paar Tricks überlegen wie Zeilen die wo keine Auswertbaren Passagen drin sind ausgeblendet werden und dann ist es geschafft.

    Das kannst Du z.B. mit einer Excelfunktion "WENN" bewerkstelligen


    =WENN(UND($F178>0,05;$F178<0,100001);1;"")


    Hier im Beispiel wird der Zellinhalt F178 auf seine Größe geprüft. In der Zelle, in der die Formel steht, erscheint eine 1 wenn der Wert in F178 zwischen 0,05 und 0,10 liegt. Liegt der Wert in F178 außerhalb dieses Bereiches bleibt die Zelle leer. Es wird auch keine 0 (Null) angezeigt. Die letzten beiden Anführungsstriche sorgen dafür, dass in der Zelle nichts angezeigt wird.


    Sobald aber der Wert in F178 zwischen 0,05 und 0,10 liegt (auch aus automatischen Berechnungen) wird die 1 angezeigt. Anstelle der 1 kann natürlich auch 'was anderes (steht zwischen den beiden ; ; ) angezeigt werden.


    Ich nutze diese Funktion in Aufmaßblättern um bei Null-Werten aus optischen Gründen ein leeres Feld zu erzeugen anstelle dort eine "0" oder "0,00" stehen zu haben.

    Gruß
    Holger
    --
    Früher, da war vieles gut. Heute ist alles besser.
    Manchmal wäre ich froh, es wäre wieder gut.
    (Andreas Marti; Schweizer)

  • Danke Holger
    Mir geht es aber um das Ausblenden ganzer Zeilen und Passagen.
    Ich bin mit dem schlimmsten Teil fertig.
    Durch etwas Trickserei geht das über Autofiltern.
    Muss nur dafür sorgen das irgendwie in den auszublendenden Zeilen "nichts" oder in allen das selbe steht.
    Für die einfache Aufgabe musste ich nun in Untiefen absteigen (eigentlich aufsteigen) die kannte ich gar nicht.


    Momentan hänge ich bei einem Problem fest:
    Ich will das Wort "Titel" in die Zelle der Spalte D stehen haben wo in der Spalte E ein eingefärbte Zelle ist.
    Momentan habe ich ein gefundenes Makro, welches dummerweise die ganze Spalte D mit dem Wörtchen "Titel: " überzieht.
    Ich möchte aber, wenn z.B. die Zelle E12 gelb ist, dass dann in D12 das Wort "Titel: " steht (+Schrift = fett)


    Das ist das Makro

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk

  • So in etwa? Colorindex = 6 ist mein 0815 xl2000 gelb.
    Achja, ich weiss nicht, was die neueren Versionen können, ggf. liesse sich das auch mit bedingter Formatierung erschlagen?


    Code
    1. Sub title_by_color()
    2. Dim cell As Range, flag As Boolean
    3. For Each cell In Application.Intersect(Range("E:E"), Me.UsedRange)
    4. If cell.Interior.ColorIndex = 6 Then
    5. cell.Offset(0, -1) = "Titel: "
    6. cell.Offset(0, -1).Font.Bold = 1
    7. End If
    8. Next
    9. End Sub

    ---
    It's not the hammer, it is the way you hit.

  • Jou
    Super
    Da doktere ich schon seit Stunden rum.
    Danke


    ---------- 16. Juni 2017, 22:48 ----------


    Ach ja, jetzt war ich so voller Begeisterung.....


    ... istv es bitte möglich noch die besagte Zelle im selben Gelb einzufärben :thumbup:

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk


  • ... istv es bitte möglich noch die besagte Zelle im selben Gelb einzufärben :thumbup:

    klaro, jetzt hab ich das auch endlich mit dem Code-Format hier gerafft, vorher hats mir den immer zerschossen ;)


    Code
    1. Sub title_by_color()
    2. Dim cell As Range, flag As Boolean
    3. For Each cell In Application.Intersect(Range("E:E"), Me.UsedRange)
    4. If cell.Interior.ColorIndex = 6 Then
    5. cell.Offset(0, -1) = "Titel: "
    6. cell.Offset(0, -1).Font.Bold = 1
    7. cell.Offset(0, -1).Interior.ColorIndex = 6
    8. End If
    9. Next
    10. End Sub

    ---
    It's not the hammer, it is the way you hit.

  • Danke


    Ich hätte schwören können das hatte ich genau so versucht?????
    Erschien irgendwie logisch.
    Obwohl, so weit will ich jetzt auch wieder nicht gehen.


    Danke noch mal.
    Bis zum nächsten Mal :D

    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk