Makros unter Excel

  • 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?

    Quellcode

    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
  • Carden Mark schrieb:


    ... 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 ;)

    Quellcode

    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
  • Mist früher wieder da wie ich hoffte.
    Ich habe das Macro jetzt hinter ein anderes gehangen.
    Ich erhalte jetzt den Fehler: Fehler beim Kompilieren unzulässige Verwendung des Schlüsselwortes me
    Hier schreibt der Jenige dessen Basiscode ich verwendet hatte: [Dieser Link ist nur für Registrierte Mitglieder sichtbar.]

    Jetziger Code:

    Quellcode

    1. Sub GesSumme_ausrechnen()
    2. '
    3. ' GesSumme_ausrechnen Makro
    4. '
    5. ' Tastenkombination: Strg+t
    6. '
    7. ActiveCell.Select
    8. ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    9. ActiveCell.Offset(1, 0).Range("A1").Select
    10. ActiveCell.FormulaR1C1 = "=R[-1]C*0.19"
    11. ActiveCell.Offset(1, 0).Range("A1").Select
    12. ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
    13. ActiveCell.Offset(-2, 0).Range("A1:A3").Select
    14. Selection.Copy
    15. ActiveCell.Offset(0, 1).Range("A1").Select
    16. ActiveSheet.Paste
    17. Application.CutCopyMode = False
    18. ActiveCell.Offset(0, -1).Range("A1").Select
    19. Selection.Copy
    20. ActiveCell.Offset(0, 9).Range("A1:F1").Select
    21. ActiveSheet.Paste
    22. Application.CutCopyMode = False
    23. ActiveCell.Offset(0, -12).Range("A1").Select
    24. ActiveCell.FormulaR1C1 = "Netto"
    25. ActiveCell.Offset(1, 0).Range("A1").Select
    26. ActiveCell.FormulaR1C1 = "MwSt. 19 %"
    27. ActiveCell.Offset(1, 0).Range("A1").Select
    28. ActiveCell.FormulaR1C1 = "Brutto"
    29. ActiveCell.Offset(-2, 0).Range("A1:A3").Select
    30. Selection.Copy
    31. ActiveCell.Offset(0, 1).Range("A1").Select
    32. ActiveSheet.Paste
    33. Application.CutCopyMode = False
    34. ActiveCell.Rows("1:3").EntireRow.Select
    35. Selection.Font.Bold = False
    36. Selection.Font.Bold = True
    37. ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
    38. Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    39. Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    40. Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    41. Selection.Borders(xlEdgeTop).LineStyle = xlNone
    42. With Selection.Borders(xlEdgeBottom)
    43. .LineStyle = xlContinuous
    44. .ColorIndex = 0
    45. .TintAndShade = 0
    46. .Weight = xlThin
    47. End With
    48. Selection.Borders(xlEdgeRight).LineStyle = xlNone
    49. Selection.Borders(xlInsideVertical).LineStyle = xlNone
    50. Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    51. ActiveCell.Offset(4, 7).Range("A1").Select
    52. ActiveCell.FormulaR1C1 = "LHH 221 = ""l"""
    53. ActiveCell.Select
    54. With Selection.Interior
    55. .Pattern = xlSolid
    56. .PatternColorIndex = xlAutomatic
    57. .Color = 65535
    58. .TintAndShade = 0
    59. .PatternTintAndShade = 0
    60. End With
    61. ActiveCell.Offset(0, 14).Columns("A:A").EntireColumn.EntireColumn.AutoFit
    62. ActiveCell.Offset(0, 13).Columns("A:A").EntireColumn.EntireColumn.AutoFit
    63. ActiveCell.Offset(0, 12).Columns("A:A").EntireColumn.EntireColumn.AutoFit
    64. ActiveCell.Offset(0, 11).Columns("A:A").EntireColumn.EntireColumn.AutoFit
    65. ActiveCell.Offset(0, 10).Columns("A:A").EntireColumn.EntireColumn.AutoFit
    66. ActiveCell.Offset(0, 9).Columns("A:A").EntireColumn.EntireColumn.AutoFit
    67. ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.EntireColumn.AutoFit
    68. ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
    69. ' Sub title_by_color()
    70. Dim cell As Range, flag As Boolean
    71. For Each cell In Application.Intersect(Range("E:E"), Me.UsedRange)
    72. If cell.Interior.ColorIndex = 6 Then
    73. cell.Offset(0, -1) = "Titel: "
    74. cell.Offset(0, -1).Font.Bold = 1
    75. cell.Offset(0, -1).Interior.ColorIndex = 6
    76. End If
    77. Next
    78. End Sub
    Alles anzeigen
    Zwischen 69 und 77 lieht der Codeschnipsel.
    Was mache ich falsch?
    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk
  • Ok nochmal ganz fix.

    Ich ging davon aus, dass du den Code für die farbigen Titel im Tabellenblattcode selbst verankert hast und nicht in einem normalen Modul.
    Denn in einem Modul hatte ich den Fehler auch.

    Der Ausdruck/Bezug auf 'Me' funktioniert nur objektbezogen, sprich in Tabellenblättern oder Userforms, in 0815-Modulen nicht.

    Aber quick & dirty:

    Quellcode

    1. Sub title_by_color()
    2. Dim cell As Range
    3. For Each cell In Range("E:E")
    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

    Ist zwar unhübsch, weil die ganze Spalte E abgeklopft wird, aber auf die Schnelle zum Testen sollte es tun.
    ---
    It's not the hammer, it is the way you hit.
  • Ich habe gemogelt bis zum geht nicht mehr und den Code einfach in die Tabelle2 in Tabelle2 des VBAMonitors reinkopiert.
    Jetzt läuft es
    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk
  • Ja, da haste Wohl recht mit.
    Dann will ich mal besser ändern.


    trekkie schrieb:

    Ist zwar unhübsch, weil die ganze Spalte E abgeklopft wird, aber auf die Schnelle zum Testen sollte es tun.
    Jetzt weiß ich auch genau was Du damit meintest.
    Ich habe Deinen neuen code mit Hochkomma und Erklärungen unter den Alten eingefügt.
    Evtl. hilft es dann mal :)


    ---------- 18. Juni 2017, 00:42 ----------

    Ich heule gleich :wall:
    Wie kann es kommen, dass in 2 verschiedene Dateien ein und das selbe Makro was anderes macht?
    Ich habe es schon hin und her kopiert.
    Hier mal der besagte Code:

    Quellcode

    1. Sub autoTietelsuÜbertrag()
    2. ' autoTietelsuÜbertrag Makro
    3. Dim SavedBook As String ' ab hier: vorgeschaltete Sicherheitskopeierstellung, falls ein Makro versehentlich aktiviert wird.
    4. Const MaxBooks = 5
    5. Dim I As Integer
    6. Dim BackupPfad As String
    7. Dim KillBook As String
    8. Application.ScreenUpdating = False
    9. Application.DisplayAlerts = False
    10. DateiName = ThisWorkbook.Name
    11. If InStr(DateiName, ".") > 0 Then
    12. DateiName = Left(DateiName, InStr(DateiName, ".") - 1)
    13. End If
    14. BackupPfad = ThisWorkbook.Path & "\Backup " & DateiName
    15. If Dir(BackupPfad, vbDirectory) = "" Then
    16. MkDir (BackupPfad)
    17. End If
    18. BackupPfad = BackupPfad & "\"
    19. SavedBook = BackupPfad & "Backup " & DateiName & " - *"
    20. KillBook = "Backup " & DateiName & " - 99999999999999.xlsm"
    21. I = 0
    22. SavedBook = Dir(SavedBook)
    23. While SavedBook <> "" And I < MaxBooks
    24. If KillBook > SavedBook Then
    25. KillBook = SavedBook
    26. End If
    27. I = I + 1
    28. SavedBook = Dir
    29. Wend
    30. If I = MaxBooks Then
    31. Kill BackupPfad & KillBook
    32. End If
    33. With ActiveWorkbook
    34. .SaveCopyAs BackupPfad & "Backup " & DateiName & " - " & _
    35. Format(Now(), "yyyymmddhhnnss") & ".xlsm"
    36. End With
    37. Application.DisplayAlerts = True
    38. Application.ScreenUpdating = True
    39. '
    40. ' Tastenkombination: Strg+f
    41. '
    42. ActiveCell.Rows("1:1").EntireRow.Select
    43. With Selection.Interior
    44. .Pattern = xlNone
    45. .TintAndShade = 0
    46. .PatternTintAndShade = 0
    47. End With
    48. Selection.Font.Bold = True
    49. ActiveCell.Offset(0, 7).Range("A1").Select
    50. ActiveCell.FormulaR1C1 = _
    51. "=SUMIF(R12C5:R[-1]C5,RC[-3],R12C8:R[-1]C8)"
    52. ActiveCell.Select
    53. Selection.Copy
    54. ActiveCell.Offset(0, 0).Range("A1,I1,J1,K1,L1,M1,N1").Select
    55. ActiveCell.Offset(0, 14).Range("A1").Activate
    56. ActiveSheet.Paste
    57. Application.CutCopyMode = False
    58. ActiveCell.Offset(0, -13).Range("A1").Select
    59. ActiveCell.FormulaR1C1 = _
    60. "=SUMIF(R[-195]C[-4]:R[-1]C[-4],RC[-4],R[-195]C:R[-1]C)"
    61. ActiveCell.Offset(0, 8).Range("A1").Select
    62. ActiveCell.FormulaR1C1 = _
    63. "=SUMIF(R[-195]C[-12]:R[-1]C[-12],RC[-12],R[-195]C:R[-1]C)"
    64. ActiveCell.Offset(0, 1).Range("A1").Select
    65. ActiveCell.FormulaR1C1 = _
    66. "=SUMIF(R[-195]C[-13]:R[-1]C[-13],RC[-13],R[-195]C:R[-1]C)"
    67. ActiveCell.Offset(0, 1).Range("A1").Select
    68. ActiveCell.FormulaR1C1 = _
    69. "=SUMIF(R[-195]C[-14]:R[-1]C[-14],RC[-14],R[-195]C:R[-1]C)"
    70. ActiveCell.Offset(0, 1).Range("A1").Select
    71. ActiveCell.FormulaR1C1 = _
    72. "=SUMIF(R[-195]C[-15]:R[-1]C[-15],RC[-15],R[-195]C:R[-1]C)"
    73. ActiveCell.Offset(0, 1).Range("A1").Select
    74. ActiveCell.FormulaR1C1 = _
    75. "=SUMIF(R[-195]C[-16]:R[-1]C[-16],RC[-16],R[-195]C:R[-1]C)"
    76. ActiveCell.Offset(0, 1).Range("A1").Select
    77. ActiveCell.FormulaR1C1 = _
    78. "=SUMIF(R[-195]C[-17]:R[-1]C[-17],RC[-17],R[-195]C:R[-1]C)"
    79. ActiveCell.Offset(1, -14).Range("A1").Select
    80. End Sub
    Alles anzeigen



    ---------- 18. Juni 2017, 00:49 ----------

    5-45 ist das vorgeschaltete SicherheitsBackup

    Das Makro soll ja in Spalte F nach Namensgleichen suchen und die Daten aus den Zeilen H;I,Q:V (eigentlich auch X;Y;AB) dann untenstehend jeweilige Zeile übertragen.
    In der einen Datei läuft es super

    Spalte H

    Quellcode

    1. =SUMMEWENN($E$12:$E228;E229;$H$12:$H228)
    2. =SUMMEWENN($E$12:$E229;E230;$H$12:$H229)
    3. =SUMMEWENN($E$12:$E230;E231;$H$12:$H230)
    4. =SUMMEWENN($E$12:$E231;E232;$H$12:$H231)
    5. =SUMMEWENN($E$12:$E232;E233;$H$12:$H232)
    6. =SUMMEWENN($E$12:$E233;E234;$H$12:$H233)
    7. =SUMMEWENN($E$12:$E234;E235;$H$12:$H234)
    8. =SUMMEWENN($E$12:$E235;E236;$H$12:$H235)



    ---------- 18. Juni 2017, 00:53 ----------

    Spalte I und folgende

    Quellcode

    1. =SUMMEWENN(E34:E228;E229;I34:I228)
    2. =SUMMEWENN(E35:E229;E230;I35:I229)
    3. =SUMMEWENN(E36:E230;E231;I36:I230)
    4. =SUMMEWENN(E37:E231;E232;I37:I231)
    5. =SUMMEWENN(E38:E232;E233;I38:I232)
    6. =SUMMEWENN(E39:E233;E234;I39:I233)
    7. =SUMMEWENN(E40:E234;E235;I40:I234)
    8. =SUMMEWENN(E41:E235;E236;I41:I235)
    Mann erkennt das sich die Verweise nicht mehr in $ befinden und daher nach unten verschoben werden. Dadurch werden Werte nicht übernommen.
    Hat einer eine Idee warum das in der einen Datei so ist und in der anderen nicht.
    Die Problem Datei basiert auf die Funktionstüchtige Datei.
    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk
  • Vielleicht probierst Du es einmal mit Namen, siehe pic > Namensfeld ganz links oben, wo die aktuelle Zelladdresse steht

    Menü Einfügen > Namen > Definieren
    oder worksheets("DeinName").names.add bzw. delete siehe Makro1 + 2

    Achja die xls.txt ist ein Versuch, speichern unter und endung txt entfernen.

    bef.xls.txt
    ---
    It's not the hammer, it is the way you hit.
  • Tut mir Trekki ich raffe es nicht
    Ich habe mal der Reihe nach das Makro mit Hochkomma abgeschaltet und geschaut was passiert.
    Hier kann man das nachlesen:

    Quellcode

    1. Sub autoTietelsuÜbertrag()
    2. ' autoTietelsuÜbertrag Makro
    3. '
    4. ' Tastenkombination: Strg+f
    5. '
    6. ActiveCell.Rows("1:1").EntireRow.Select ' markiert die ganze Zeile
    7. With Selection.Interior 'löscht die Farbe in der Zeile
    8. .Pattern = xlNone
    9. .TintAndShade = 0
    10. .PatternTintAndShade = 0
    11. End With
    12. Selection.Font.Bold = True 'macht die Schrift fett
    13. ActiveCell.Offset(0, 7).Range("A1").Select ' Offset=suchen, Range = werden Bereiche in der Exceltabelle angesprochen,
    14. 'ausgehend von der aktuellen Zelle 7 Zeilen nach rechts geht
    15. 'um von dort aus dann A1 zu selektieren, in diesem Fall sorgt es nach dem entfärben
    16. 'der Spalte das der Curser wieder aud E springt
    17. ActiveCell.FormulaR1C1 = _
    18. "=SUMIF(R12C5:R[-1]C5,RC[-3],R12C8:R[-1]C8)" ' fügt hier Formel ein =SUMMEWENN($E$12:$E228;E229;$H$12:$H228)
    19. ActiveCell.Select 'markiert die betreffende Zelle
    20. Selection.Copy 'Führt eine Kopierfunktion aus
    21. ActiveCell.Offset(0, 0).Range("A1,I1,J1,K1,L1,M1,N1").Select ' übersptingt I:O und makiert P:U
    22. ActiveCell.Offset(0, 14).Range("A1").Activate 'springt in die 14 Zelle von der aktiven Zelle =V
    23. ActiveSheet.Paste 'fügt ein =SUMMEWENN($E$12:$E228;S229;$H$12:$H228)' warum macht er das? Er führt doch am Ende des Makros V durch.
    24. Application.CutCopyMode = False
    25. ActiveCell.Offset(0, -13).Range("A1").Select 'springt 13 Zellen nach links = I
    26. ActiveCell.FormulaR1C1 = _
    27. "=SUMIF(R[-195]C[-4]:R[-1]C[-4],RC[-4],R[-195]C:R[-1]C)" 'fügt ein =SUMMEWENN(E34:E228;E229;I34:I228)Also anstelle ab Zeile 12 ab Zeile 34
    28. ActiveCell.Offset(0, 8).Range("A1").Select 'springt 8 Zellen nach rechts = Q
    29. ActiveCell.FormulaR1C1 = _
    30. "=SUMIF(R[-195]C[-12]:R[-1]C[-12],RC[-12],R[-195]C:R[-1]C)" '=SUMMEWENN(E34:E228;E229;Q34:Q228)Also anstelle ab Zeile 12 ab Zeile 34
    31. ActiveCell.Offset(0, 1).Range("A1").Select 'springt 1 Zellen nach rechts = R
    32. ActiveCell.FormulaR1C1 = _
    33. "=SUMIF(R[-195]C[-13]:R[-1]C[-13],RC[-13],R[-195]C:R[-1]C)" '=SUMMEWENN(E34:E228;E229;R34:R228)Also anstelle ab Zeile 12 ab Zeile 34
    34. ActiveCell.Offset(0, 1).Range("A1").Select 'springt 1 Zellen nach rechts = S
    35. ActiveCell.FormulaR1C1 = _
    36. "=SUMIF(R[-195]C[-14]:R[-1]C[-14],RC[-14],R[-195]C:R[-1]C)" '=SUMMEWENN(E34:E228;E229;S34:S228)Also anstelle ab Zeile 12 ab Zeile 34
    37. ActiveCell.Offset(0, 1).Range("A1").Select 'springt 1 Zellen nach rechts = T
    38. ActiveCell.FormulaR1C1 = _
    39. "=SUMIF(R[-195]C[-15]:R[-1]C[-15],RC[-15],R[-195]C:R[-1]C)" '=SUMMEWENN(E34:E228;E229;T34:T228)Also anstelle ab Zeile 12 ab Zeile 34
    40. ActiveCell.Offset(0, 1).Range("A1").Select 'springt 1 Zellen nach rechts = U
    41. ActiveCell.FormulaR1C1 = _
    42. "=SUMIF(R[-195]C[-16]:R[-1]C[-16],RC[-16],R[-195]C:R[-1]C)" '=SUMMEWENN(E34:E228;E229;U34:U228)Also anstelle ab Zeile 12 ab Zeile 34
    43. ActiveCell.Offset(0, 1).Range("A1").Select 'springt 1 Zellen nach rechts = V
    44. ActiveCell.FormulaR1C1 = _
    45. "=SUMIF(R[-195]C[-17]:R[-1]C[-17],RC[-17],R[-195]C:R[-1]C)" '=SUMMEWENN(E34:E228;E229;V34:V228)Also anstelle ab Zeile 12 ab Zeile 34
    46. ActiveCell.Offset(1, -14).Range("A1").Select '14 Zellen zurück, 1 Zelle Runter = 1unter dem Ausgangspunkt des Makros
    47. End Sub
    Alles anzeigen



    ---------- 18. Juni 2017, 23:49 ----------

    H=SUMMEWENN($E$12:$E228;E229;$H$12:$H228)=SUMIF(R12C5:R[-1]C5,RC[-3],R12C8:R[-1]C8)
    I=SUMMEWENN(E34:E228;E229;I34:I228)=SUMIF(R[-195]C[-4]:R[-1]C[-4],RC[-4],R[-195]C:R[-1]C)
    Q=SUMMEWENN(E34:E228;E229;Q34:Q228)=SUMIF(R[-195]C[-12]:R[-1]C[-12],RC[-12],R[-195]C:R[-1]C)
    R=SUMMEWENN(E34:E228;E229;R34:R228)=SUMIF(R[-195]C[-13]:R[-1]C[-13],RC[-13],R[-195]C:R[-1]C)
    S=SUMMEWENN(F34:F228;F229;S34:S228)=SUMIF(R[-195]C[-14]:R[-1]C[-14],RC[-14],R[-195]C:R[-1]C)
    T=SUMMEWENN(F34:F228;F229;T34:T228)=SUMIF(R[-195]C[-15]:R[-1]C[-15],RC[-15],R[-195]C:R[-1]C)
    U=SUMMEWENN(F34:F228;F229;U34:U228)=SUMIF(R[-195]C[-16]:R[-1]C[-16],RC[-16],R[-195]C:R[-1]C)
    V=SUMMEWENN(F34:F228;F229;V34:V228)=SUMIF(R[-195]C[-17]:R[-1]C[-17],RC[-17],R[-195]C:R[-1]C)

    Ich habe keine Ahnung was die rechten Codeschnipsel anstellen.
    Ich verstehe auch nicht, warum der Code vom Ausgang Zeile "I" erst in "V" springt und hier die Identische Formel einfügt wie in "I" um dann zum Ende das Ganze wieder zu überschreiben.


    ---------- 19. Juni 2017, 07:59 ----------

    Wenn ich mir die älteren Dateien so anschaue, wo der Code funktioniert, erkenne ich als Unterschied folgendes.
    • Es wurden noch 7 Tabellenblätter angefügt
    • 6 Davon haben Verknüpfungen zum Tabellenblatt " LV " wo das Problemmakro ausgeführt werden soll.
    • Und zwar werden in den Zeilen 1+2 des T.Blatts " LV " folgende Index-Verweise ausgeführt:
      • F2= =INDEX(I12:I584;VERGLEICH(F1;F12:F584;0))
      • F3= =INDEX(H12:H618;VERGLEICH(F3;F12:F618;0))
      • H2= =INDEX( LV !R12:R584;VERGLEICH(H1; LV !R12:R584;0)-3;0)
      • Q1= =INDEX(Q12:Q584;VERGLEICH(Q1;Q12:Q584;0)-1;0)
      • S1= =INDEX(S12:S584;VERGLEICH(S1;S12:S584;0)-1;0)
      • T1= =INDEX(T12:T584;VERGLEICH(T1;T12:T584;0)-1;0)
      Könnte die nachträgliche Änderung was damit zutun haben?
    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk
  • Mark, mit dem Recordermüll kommst Du nicht weit,
    diese ganzen Offsets, selects und activates verwirren und sind kreuzgefährlich.
    Am besten, du sprichst die Zellen direkt an, ohne select, dann wirds auch übersichtlicher.


    Ich hab mal den Codesnippet Zeile 16 bis 27 versucht zu kommentieren in einer eigenen kleinen Sub,
    hoffe so kannst Du (nur diesen Part) erstmal besser verstehen.


    Arbeite auch mit dem Direktfenster, hier kannst du viel Informationen abrufen,
    einfach einleitend mit einem '?' gefolgt von Befehl und abentern, siehe Pic


    ... beispielsweise eine andere Formelschreibweise als das R1C1-Gedöns,
    zB Formula oder FormulaLocal-Ausdrücke sind besser lesbar


    BTW, das Direktfenster ist kontextsensitive, sprich bei korrekter Schreibweise macht es gleich Vorschläge ;)


    Keine Angst, mit dem Direktfenster kannste auch rechnen, einfach eintippen:


    ?2+3 [Enter]
    5


    u.ä. lustige Fragen ;)


    Erstmal bis hierhin
    --

    Quellcode

    1. Option Explicit
    2. Sub asdf()
    3. 'Activecell = A10 bei mir
    4. 'der Zelle H10 wird hiermit die Formel verpasst, siehe Direktfenster
    5. ActiveCell.Offset(0, 7).FormulaR1C1 = "=SUMIF(R12C5:R[-1]C5,RC[-3],R12C8:R[-1]C8)"
    6. 'besser wäre natürlich gleich
    7. Range("H10").FormulaR1C1 = "=SUMIF(R12C5:R[-1]C5,RC[-3],R12C8:R[-1]C8)"
    8. 'oder
    9. Range("H10").Formula = "=SUMIF($E9:$E$12,E10,$H9:$H$12)"
    10. Selection.Copy 'kopiert H10 in die Zwischenablage
    11. 'Recordermüll ActiveCell.Offset(0, 0).Range("A1,I1,J1,K1,L1,M1,N1").Select ' übersptingt I:O und makiert P:U
    12. 'ActiveCell.Offset(0, 14).Range("A1").Activate 'springt in V10
    13. ActiveSheet.Paste 'fügt in die aktive Zelle V10 den Inhalt aus der ZA ein, also deine Formel aus H10
    14. Application.CutCopyMode = False 'Pendant zu ESC, deaktiviert die Kopierfunktion der Zwischenablage
    15. 'erstmal bis hierhin
    16. End Sub
    Alles anzeigen
    ---
    It's not the hammer, it is the way you hit.
  • Das ist ja schon eine gute Übersetzung was das Direktfenster macht.
    Wie bekomme ich aber den code dann als ausführbares Makro?
    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk
  • Ehm ... *puzzled*
    Wie hast du deine Makros bzw. deinen Code bisher zum Laufen gebracht?

    Mache mal im VBE [Aufruf Alt+F11) Menue Einfügen > Modul
    In das neue/leere Modulfenster tippst Du:

    sub blablub [Enter]

    es erscheint automatisch:

    sub blablub() 'automatisch

    'hier dein Code
    msgbox "done"

    end sub 'automatisch

    Dazwischen schreibst Du deinen Code bzw. fügst via copypaste Formeln etc aus dem DF ein.

    Kann aber auch sein, ich hab deine Frage nicht verstanden.
    ---
    It's not the hammer, it is the way you hit.
  • Naja, an so etwas einfachen wie CopyPaste bin ich nicht gekommen.
    Alles andere erscheint auch so kompliziert :blond:
    Aber einen habe ich noch für Dich.
    Dann haste erst einmal Pause: Ich muss nämlich morgen auch wieder ernsthaft arbeiten.

    Das folgende Makro summiert alle über der aktiven Zelle befindlichen Summen bis zur nächsten leeren Zelle zusammen.

    Quellcode

    1. Sub SummenBisLeerzelleEinfügen()
    2. Dim Zelle As Range
    3. Dim rng As Range
    4. For Each Zelle In Selection
    5. If Zelle.Offset(-1, 0).Value = "" Then
    6. Set rng = Nothing
    7. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    8. Set rng = Zelle.Offset(-1, 0)
    9. Else
    10. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0))
    11. End If
    12. If Not rng Is Nothing Then
    13. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    14. End If
    15. Next
    16. End Sub
    Alles anzeigen
    Ich bin jetzt so ziemlich durch den Wind, denn ich möchte das dieses Makro zeitgleich in den Zellen I,Q, R, S, T, U, V, X, Y und AB ausgeführt wird.
    Irgendwie stelle ich mich da zu blöde an oder ich sehen den Wald vor lauter Bäume nicht mehr.
    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk
  • Carden Mark schrieb:

    Ich bin jetzt so ziemlich durch den Wind, denn ich möchte das dieses Makro zeitgleich in den Zellen I,Q, R, S, T, U, V, X, Y und AB ausgeführt wird.
    Irgendwie stelle ich mich da zu blöde an oder ich sehen den Wald vor lauter Bäume nicht mehr.
    Oki, nicht sonderlich getestet, wichtig ist halt deine Cursorposition (Activecell) > damit steht oder fällt alles,
    HTH Nancy

    Quellcode

    1. Sub asdf()
    2. Dim r&, c%, i&, arr
    3. arr = Array("I", "Q", "R", "S", "T", "U", "V", "X", "Y", "AB")
    4. For c = LBound(arr) To UBound(arr)
    5. i = ActiveCell.Row - 1
    6. For r = ActiveCell.Row - 1 To 5 Step -1
    7. If Cells(r - 1, arr(c)) = "" Then
    8. Cells(ActiveCell.Row, arr(c)).Formula = "=Sum(" & arr(c) & CStr(r) & ":" & arr(c) & CStr(i) & ")"
    9. Exit For
    10. End If
    11. Next
    12. Next
    13. End Sub
    Alles anzeigen
    ---
    It's not the hammer, it is the way you hit.
  • Kaum hatte ich das hier geschrieben, hatte ich die Erleuchtung:
    Ich hatte das was ich in einem Forum gelesen hatte falsch interpretiert.

    Quellcode

    1. Sub GesamtsummenBisLeerzelleEinfügen()
    2. ActiveCell.Range("A1,B1,K1,M1,N1,O1,Q1,R1").Select
    3. ActiveCell.Offset(0, 17).Range("A1").Activate
    4. Dim Zelle As Range
    5. Dim rng As Range
    6. For Each Zelle In Selection
    7. If Zelle.Offset(-1, 0).Value = "" Then
    8. Set rng = Nothing
    9. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    10. Set rng = Zelle.Offset(-1, 0)
    11. Else
    12. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0))
    13. End If
    14. If Not rng Is Nothing Then
    15. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    16. End If
    17. Next
    18. End Sub
    Alles anzeigen
    Das Problem hatte ich heute Nacht noch gelöst.
    Dein Makro sieht aber irgendwie - aufgeräumter aus.
    Ich versuche den Mal

    Es gibt ja sie Möglichkeit, basierend auf Inhalte einer Zelle die ganze Zeile zu löschen.
    Geht das auch, dass ich dem sage: Worksheet "ME", wenn hier in einer Zelle E ein "*" ist, dann die ganze Zeile plus noch 7 Zeilen darunter zu löschen?
    Der müsste doch dann vermutlich von unten nach oben suchen?


    ---------- 22. Juni 2017, 18:40 ----------

    Auch erledigt :)

    Das Ding wird langsam.


    ---------- 9. Juli 2017, 16:33 ----------

    Jetzt hatte ich geglaubt ich habe das Ding fehlerfrei am Laufen und nun, nach mehrfacher Nutzung stellt sich ein Fehler heraus.
    Bei der Bildung der Titelsummen mit:

    Quellcode

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



    Funktioniert dieses überall gut, da wo mindestens 2 Positionen zuzüglich Titelüberschrift und Titelsumme vorhanden sind.
    Dort wo nur 1 Position vorhanden ist, rechnet das Makro die nächste Titelsumme mit ein.

    Beispiel: siehe pdf.
    Unter"Summe: Titel Rückbau Luftkanal im Doppelboden" steht "=SUMME($H$87:$H$94)" Es rechnet also bis zur Spalte unter der Überschrift alles zusammen.
    Unter: "Summe: Titel gemeinsame Leistungen HS" steht aber "=SUMME($I$50:$I$53)", es rechnet die Titelsumme aus den "Stundenlohnarbeite" auch noch dazu.
    Wenn ich künstlich noch eine Spalte unter "Summe: Titel gemeinsame Leistungen HS" einfüge, rechnet er richtigerweise nur bis zur Spalte unter der Überschrift alles zusammen.
    Aus irgend einen Grund kommt das Makro offenbar mit nur der einen Spalte nicht klar.

    Woran liegt das?
    Kann man das bessern?


    ---------- 9. Juli 2017, 22:28 ----------

    gelöst:

    Quellcode

    1. ' Titelsummen bilden, kopieren, Spalte eingrauen+Dickschrift,Sternchen
    2. Dim SavedBook As String ' ab hier: vorgeschaltete Sicherheitskopeierstellung, falls ein Makro versehentlich aktiviert wird.
    3. Const MaxBooks = 5
    4. Dim I As Integer
    5. Dim BackupPfad As String
    6. Dim KillBook As String
    7. Application.ScreenUpdating = False
    8. Application.DisplayAlerts = False
    9. DateiName = ThisWorkbook.Name
    10. If InStr(DateiName, ".") > 0 Then
    11. DateiName = Left(DateiName, InStr(DateiName, ".") - 1)
    12. End If
    13. BackupPfad = ThisWorkbook.Path & "\Backup " & DateiName
    14. If Dir(BackupPfad, vbDirectory) = "" Then
    15. MkDir (BackupPfad)
    16. End If
    17. BackupPfad = BackupPfad & "\"
    18. SavedBook = BackupPfad & "Backup " & DateiName & " - *"
    19. KillBook = "Backup " & DateiName & " - 99999999999999.xlsm"
    20. I = 0
    21. SavedBook = Dir(SavedBook)
    22. While SavedBook <> "" And I < MaxBooks
    23. If KillBook > SavedBook Then
    24. KillBook = SavedBook
    25. End If
    26. I = I + 1
    27. SavedBook = Dir
    28. Wend
    29. If I = MaxBooks Then
    30. Kill BackupPfad & KillBook
    31. End If
    32. With ActiveWorkbook
    33. .SaveCopyAs BackupPfad & "Backup " & DateiName & " - " & _
    34. Format(Now(), "yyyymmddhhnnss") & ".xlsm"
    35. End With
    36. Application.DisplayAlerts = True
    37. Application.ScreenUpdating = True
    38. ' Tastenkombination: Strg+s
    39. Dim Zelle As Range 'Zelle H
    40. Dim rng As Range
    41. For Each Zelle In Selection
    42. If Zelle.Offset(-1, 0).Value = "" Then
    43. Set rng = Nothing
    44. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    45. Set rng = Zelle.Offset(-1, 0)
    46. Else
    47. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0))
    48. End If
    49. If Not rng Is Nothing Then
    50. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    51. End If
    52. Next
    53. ActiveCell.Offset(0, 1).Range("A1").Select ' Zelle I
    54. For Each Zelle In Selection
    55. If Zelle.Offset(-1, 0).Value = "" Then
    56. Set rng = Nothing
    57. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    58. Set rng = Zelle.Offset(-1, 0)
    59. Else
    60. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0)) 'xlUp" ist die Richtung in welche EXCEL suchen soll
    61. End If
    62. If Not rng Is Nothing Then
    63. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    64. End If
    65. Next
    66. ActiveCell.Offset(0, 8).Range("A1").Select ' Zelle Q
    67. For Each Zelle In Selection
    68. If Zelle.Offset(-1, 0).Value = "" Then
    69. Set rng = Nothing
    70. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    71. Set rng = Zelle.Offset(-1, 0)
    72. Else
    73. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0)) 'xlUp" ist die Richtung in welche EXCEL suchen soll
    74. End If
    75. If Not rng Is Nothing Then
    76. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    77. End If
    78. Next
    79. ActiveCell.Offset(0, 1).Range("A1").Select 'Zelle R
    80. For Each Zelle In Selection
    81. If Zelle.Offset(-1, 0).Value = "" Then
    82. Set rng = Nothing
    83. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    84. Set rng = Zelle.Offset(-1, 0)
    85. Else
    86. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0)) 'xlUp" ist die Richtung in welche EXCEL suchen soll
    87. End If
    88. If Not rng Is Nothing Then
    89. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    90. End If
    91. Next
    92. ActiveCell.Offset(0, 1).Range("A1").Select ' Zelle S
    93. For Each Zelle In Selection
    94. If Zelle.Offset(-1, 0).Value = "" Then
    95. Set rng = Nothing
    96. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    97. Set rng = Zelle.Offset(-1, 0)
    98. Else
    99. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0)) 'xlUp" ist die Richtung in welche EXCEL suchen soll
    100. End If
    101. If Not rng Is Nothing Then
    102. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    103. End If
    104. Next
    105. ActiveCell.Offset(0, 1).Range("A1").Select ' Zelle T
    106. For Each Zelle In Selection
    107. If Zelle.Offset(-1, 0).Value = "" Then
    108. Set rng = Nothing
    109. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    110. Set rng = Zelle.Offset(-1, 0)
    111. Else
    112. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0)) 'xlUp" ist die Richtung in welche EXCEL suchen soll
    113. End If
    114. If Not rng Is Nothing Then
    115. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    116. End If
    117. Next
    118. ActiveCell.Offset(0, 1).Range("A1").Select ' Zelle U
    119. For Each Zelle In Selection
    120. If Zelle.Offset(-1, 0).Value = "" Then
    121. Set rng = Nothing
    122. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    123. Set rng = Zelle.Offset(-1, 0)
    124. Else
    125. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0)) 'xlUp" ist die Richtung in welche EXCEL suchen soll
    126. End If
    127. If Not rng Is Nothing Then
    128. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    129. End If
    130. Next
    131. ActiveCell.Offset(0, 1).Range("A1").Select ' Zelle V
    132. For Each Zelle In Selection
    133. If Zelle.Offset(-1, 0).Value = "" Then
    134. Set rng = Nothing
    135. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    136. Set rng = Zelle.Offset(-1, 0)
    137. Else
    138. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0)) 'xlUp" ist die Richtung in welche EXCEL suchen soll
    139. End If
    140. If Not rng Is Nothing Then
    141. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    142. End If
    143. Next
    144. ActiveCell.Offset(0, 1).Range("A1").Select ' Zelle W
    145. For Each Zelle In Selection
    146. If Zelle.Offset(-1, 0).Value = "" Then
    147. Set rng = Nothing
    148. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    149. Set rng = Zelle.Offset(-1, 0)
    150. Else
    151. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0)) 'xlUp" ist die Richtung in welche EXCEL suchen soll
    152. End If
    153. If Not rng Is Nothing Then
    154. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    155. End If
    156. Next
    157. ActiveCell.Offset(0, 1).Range("A1").Select ' Zelle X
    158. For Each Zelle In Selection
    159. If Zelle.Offset(-1, 0).Value = "" Then
    160. Set rng = Nothing
    161. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    162. Set rng = Zelle.Offset(-1, 0)
    163. Else
    164. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0)) 'xlUp" ist die Richtung in welche EXCEL suchen soll
    165. End If
    166. If Not rng Is Nothing Then
    167. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    168. End If
    169. Next
    170. ActiveCell.Offset(0, 1).Range("A1").Select ' Zelle Y
    171. For Each Zelle In Selection
    172. If Zelle.Offset(-1, 0).Value = "" Then
    173. Set rng = Nothing
    174. ElseIf Zelle.Offset(-2, 0).Value = "" Then
    175. Set rng = Zelle.Offset(-1, 0)
    176. Else
    177. Set rng = Range(Zelle.Offset(-1, 0).End(xlUp), Zelle.Offset(-1, 0)) 'xlUp" ist die Richtung in welche EXCEL suchen soll
    178. End If
    179. If Not rng Is Nothing Then
    180. Zelle.Formula = "=Sum(" & rng.Address(0, 0) & ")"
    181. End If
    182. Next
    183. ActiveCell.Rows("1:1").EntireRow.Select 'ab hier Zeile, markieren, grau,
    184. With Selection.Interior
    185. .Pattern = xlSolid
    186. .PatternColorIndex = xlAutomatic
    187. .ThemeColor = xlThemeColorDark1
    188. .TintAndShade = -4.99893185216834E-02
    189. .PatternTintAndShade = 0
    190. End With
    191. With Selection.Font 'ab hier Zeile, dicke Schrift
    192. .Name = "Arial"
    193. .FontStyle = "Fett"
    194. .Strikethrough = False
    195. .Superscript = False
    196. .Subscript = False
    197. .OutlineFont = False
    198. .Shadow = False
    199. .Underline = xlUnderlineStyleNone
    200. .TintAndShade = 0
    201. .ThemeFont = xlThemeFontNone
    202. End With
    203. I = ActiveCell.Row
    204. Cells(I, 4).FormulaR1C1 = "*" 'Sternchen in Spalte D
    205. ActiveCell.Value = ""
    206. ActiveCell.Font.Bold = True
    207. 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
    208. 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
    209. Cells(I + 1, 4).Select 'ein runter, null nach rechts
    210. Cells(I + 1, 4).FormulaR1C1 = "." 'ein runter, null nach rechts, einfügen "." damit der Autofilter nicht in der ersten Leerzelle hängen bleibt
    211. Cells(I + 2, 4).FormulaR1C1 = "." 'wie vor
    212. Cells(I + 2, 8).Select 'null runter, zwei nach rechts
    213. End Sub
    Alles anzeigen
    Dateien
    öffentlich bestellter und vereidigter Sachverständiger für das Maurer- und Betonbauerhandwerk
  • Benutzer online 1

    1 Besucher