Ecxel Fenster sichtbar machen

...komplette Frage anzeigen

3 Antworten

Hi,

Die Anpassung an eingefügte Zeilen kannst Du z.B. so erreichen. Das simuliert das Verhalten von STRG und Cursor Down, ohne jedoch die aktive Zelle oder die Auswahl zu verschieben (kein .Select!). Den Codeschnippsel kannst Du leicht selber anpassen und in Dein Makro einbauen.

Sub Bereich_Anpassen() Dim LetzteZeile As Long

LetzteZeile = [h6].End(xlDown).Row Sheets("Vorgabe").[D16] = Application.WorksheetFunction.Sum(Range("h6:h" & LetzteZeile)) End Sub

Insgesamt erscheint es mir, als würde hier mit großen Kanonen auf Spatzen geschossen werden. Vieles ist sicher auch mit Excel Bordmitteln ohne VBA zu erreichen.

Wenn VBA (und ich gestehe, dass das Spaß machen kann) solltest Du Dir mal die Anweisung Select Case ansehen. Damit könntest Du die umständliche Schachtelung der If Then ElseIf Anweisungen viel eleganter lösen. Ich vermute, dass Du dann auch mit einem einzigen Block an Berechnungen auskommen würdest.

Viel Erfolg

Hannes62a

wer braucht schon die nacht zum Schlafen??? lernen wir doch lieber VBA

Hier sind meine ersten Schritte: zu Beginn wollte ich 4 Diagramme jeweils sichtbar machen, je nach dem was in bspw. D14 steht. So ein Diagram aber fix fertig zu formatieren und das alles in VBA ist sehr mühsam, deswegen habe ich einfach die Datenquelle in VBA festgelegt, mehr oder weniger. Das Diagram greift auf 3 fixe Zellen zu, die sich aber je nach dem WErt in Zelle D14 ändern.:

Sub dia()
If Sheets("Vorgabe").Range("D14").Value = "CAD" Then
  Sheets("Vorgabe").Range("c17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), "R CAD")
  Sheets("Vorgabe").Range("E17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), "F CAD")
  Sheets("Vorgabe").Range("D16") = Application.WorksheetFunction.Sum(Range("G12:G6"))
  Sheets("Vorgabe").Range("F16") = Application.WorksheetFunction.Sum(Range("G12:G6"))
ElseIf Sheets("Vorgabe").Range("D14").Value = "Bemessern" Then
  Sheets("Vorgabe").Range("C17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), "R Bemessern")
  Sheets("Vorgabe").Range("E17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), "F Bemessern")
  Sheets("Vorgabe").Range("D16") = Application.WorksheetFunction.Sum(Range("K6:K12"))
  Sheets("Vorgabe").Range("F16") = Application.WorksheetFunction.Sum(Range("J6:J12"))
  Sheets("Vorgabe").Range("E16") = Application.WorksheetFunction.Sum(Range("o6:o12"))
ElseIf Sheets("Vorgabe").Range("D14").Value = "Ausbrecher" Then
  Sheets("Vorgabe").Range("C17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), "R Ausbrecher")
  Sheets("Vorgabe").Range("E17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), "F Ausbrecher")
  Sheets("Vorgabe").Range("D16") = Application.WorksheetFunction.Sum(Range("M6:M12"))
  Sheets("Vorgabe").Range("E16") = Application.WorksheetFunction.Sum(Range("N6:N12"))
  Sheets("Vorgabe").Range("F16") = Application.WorksheetFunction.Sum(Range("M6:M12"))
ElseIf Sheets("Vorgabe").Range("D14").Value = "Laser" Then
  Sheets("Vorgabe").Range("C17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), "R Laser")
  Sheets("Vorgabe").Range("E17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), "F Laser")
  Sheets("Vorgabe").Range("c16") = Application.WorksheetFunction.Sum(Range("L6:L12"))
  Sheets("Vorgabe").Range("E16") = Application.WorksheetFunction.Sum(Range("o6:o12"))
  Sheets("Vorgabe").Range("F16") = Application.WorksheetFunction.Sum(Range("L6:L12"))
ElseIf Sheets("Vorgabe").Range("D14").Value = "Gummi" Then
  Sheets("Vorgabe").Range("C17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), "R Gummi")
  Sheets("Vorgabe").Range("E17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), "F Gummi")
  Sheets("Vorgabe").Range("c16") = Application.WorksheetFunction.Sum(Range("L6:L12"))
  Sheets("Vorgabe").Range("E16") = Application.WorksheetFunction.Sum(Range("q6:q12"))
  Sheets("Vorgabe").Range("F16") = Application.WorksheetFunction.Sum(Range("l16:j16"))
  Sheets("Vorgabe").Range("D16") = Application.WorksheetFunction.Sum(Range("h6:h12"))
            End If

Jedoch hab ich nun Folgendes Problem. Dieses MAkro erstezt die Funtkion Zählenwenn().

  1. Problem: wenn ich eine Zeile Einfüge, wird das MAkro plötzlich nicht um eine Zeile erweitert. sondern es bleibt bspw. bei h6:h12 anstatt auf h6:h13 überzuspringen.

  2. Problem, derzeit habe ich ein Grafik mit dem Makroverwiesen(eine art Aktualisieren-Foto) bei dem man das MAkro aktualisiert. Toll wäre es aber wenn sich die Summen ständig aktualisieren, wie wenn ich =Summe() hätte. Außerdem wäre es auch noch erstrebenswert, wenn sich die Summen aktualisieren, wenn ich in D14(ist ein Drop-Downfeld, Daten->Gültigkeit...) den Inhalt ändere. Dafür habe ich auch diesen Code, jedoch muss man auf das Feld klicken, es genügt nicht nur den wert Mitttels Dropw-Downfeld zu ändern:

    Option Explicit
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("D14")) Is Nothing Then
    Call dia
    End If
    End Sub
    
Oubyi 07.09.2011, 16:00

Erstmal schnell zu Problem Nummer 2:
Lass' mal das Selection weg, also:
Private Sub Worksheet_Change(ByVal Target As Range)
...dann solltest Du das richtige Ereignis haben, dass auf Änderungen des Wertes reagiert.

0
Oubyi 07.09.2011, 16:39
@Oubyi

Jetzt zum Rest:
Es könnte sein, dass das Ganze auch ohne VBA zu regeln ist, aber ich will Dich nicht am VBA-Lernen hindern.
Ein bisschen kürzen würde ich Deine Code erstmal so:

Sub dia()
Dim strVorgabe As String

strVorgabe = Range("D14").Value

Sheets("Vorgabe").Range("C17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), strVorgabe)
Sheets("Vorgabe").Range("E17") = Application.WorksheetFunction.CountIf(Range("A1:A64"), strVorgabe)

If strVorgabe = "CAD" Then
Sheets("Vorgabe").Range("D16") = Application.WorksheetFunction.Sum(Range("G12:G6"))
Sheets("Vorgabe").Range("F16") = Application.WorksheetFunction.Sum(Range("G12:G6"))

ElseIf strVorgabe = "Bemessern" Then
Sheets("Vorgabe").Range("D16") = Application.WorksheetFunction.Sum(Range("K6:K12"))
Sheets("Vorgabe").Range("F16") = Application.WorksheetFunction.Sum(Range("J6:J12"))
Sheets("Vorgabe").Range("E16") = Application.WorksheetFunction.Sum(Range("o6:o12"))

ElseIf strVorgabe = "Ausbrecher" Then
Sheets("Vorgabe").Range("D16") = Application.WorksheetFunction.Sum(Range("M6:M12"))
Sheets("Vorgabe").Range("E16") = Application.WorksheetFunction.Sum(Range("N6:N12"))
Sheets("Vorgabe").Range("F16") = Application.WorksheetFunction.Sum(Range("M6:M12"))

ElseIf strVorgabe = "Laser" Then
Sheets("Vorgabe").Range("c16") = Application.WorksheetFunction.Sum(Range("L6:L12"))
Sheets("Vorgabe").Range("E16") = Application.WorksheetFunction.Sum(Range("o6:o12"))
Sheets("Vorgabe").Range("F16") = Application.WorksheetFunction.Sum(Range("L6:L12"))

ElseIf strVorgabe = "Gummi" Then
Sheets("Vorgabe").Range("c16") = Application.WorksheetFunction.Sum(Range("L6:L12"))
Sheets("Vorgabe").Range("E16") = Application.WorksheetFunction.Sum(Range("q6:q12"))
Sheets("Vorgabe").Range("F16") = Application.WorksheetFunction.Sum(Range("l16:j16"))
Sheets("Vorgabe").Range("D16") = Application.WorksheetFunction.Sum(Range("h6:h12"))
End If
End Sub

Zu Deinem Problem1:
Ohne den Aufbau Deiner Tabelle zu kennen ist es schwierig etwas dazu zu sagen.
Wenn in den jeweiligen Spalten keine weiteren Werte stehen, würde ich einfach:
.Sum(Range("h6:h100"))
schreiben, und "gut is'" !
Man kann auch die letzte beschriebene Zelle in einem Bereich per VBA auslesen, aber wenn es nicht nötig ist....

0
jumbo125 07.09.2011, 18:01
@Oubyi

Problem 2: habe ich schon im Laufe des Vormittags lösen können. Hab den COde gefunden und angepasst: Private Sub Worksheet_Change(ByVal Target As Range) 'Target wird auf den sich überschneidenden Bereich gesetzt, um bei 'Mehrfachmarkierungen die ausserhalb des eingeschränkten Bereiches 'liegenden Zellen nicht ebenfalls zu verändern

'Hier den Bereich anpassen
    Set Target = Application.Intersect(Target, Range("D14:A5:r12"))

    'Wenn nicht innerhalb des Bereiches wird die Prozedur verlassen
    If Target Is Nothing Then Exit Sub

    'Errorhandling aktivieren, um im Falle eines Fehlers die Ereignisse
    'am Ende wieder zu aktivieren
    On Error GoTo ErrorHandler

    'Ereignisse ausschalten, um das Change-Ereignis nicht erneut auszulösen
    Application.EnableEvents = False

    'Eine Range-Variable deklarieren
    Dim rngZelle As Range

    'jede Zelle innerhalb des Target-Bereiches durchlaufen
    For Each rngZelle In Target

   Call dia

    'Dein Code zur Bearbeitung der Zelle


    Next rngZelle
ErrorHandler:
    Application.EnableEvents = True   'Ereignisse wieder einschalten
End Sub

bei problem 1 dachte ich mir auch schon das ich einfach h6:h100 eingebe, jedoch wird die Tabelle, dir oberhalb vom Diagramm liegt noch dreimal genau unterhalb hinein kopiert. Würde ich dem zufolge h6:h100 schreibe, würden auch die WErte der darunterliegenden Tabelle mitgerechnet werden, obwohl jede Tabelle als neue Woche gilt. Lange Rede kurzer Sinn(mein Notebook dreht sich andauernd ab, und die erste Version war fast doppelt so lange ;-) ), sieh es dir bitte selbst an

https://rapidshare.com/files/3792130385/neu.xls - neu.xls ist die Diagramm-Makro Version von der anderen Datei.

https://rapidshare.com/files/1883642998/instandhaltung1.xls - instandhaltung1.xls ist deshalb so groß, da sich schon alle Monate im Tabellenverzeichnis befinden, d.h. 12 tabellenblätter + 1 vorlage + listentabelle. In ihr befinden sich alle Diagramme.

0
jumbo125 07.09.2011, 18:10
@jumbo125

hab ein makro zum zeileneinfügenertsellt, das ev. nicht ganz korrekt ist, aber prima funktioniert

0
jumbo125 07.09.2011, 19:53
@jumbo125

hab den code nochmals überarbeitet und bin völlig zufrieden Damit. JEtzt wäre nur mehr das Problem mit dem Zeileneinfügen

0
Hannes62a 07.09.2011, 23:41
@Oubyi

Wie findet Ihr diese Version? Deutlich übersichtlicher, oder?

Sub dia() Set WSF = Application.WorksheetFunction

With Sheets("Vorgabe")
  .Range("c17") = WSF.CountIf(Range("A1:A64"), "R " & .Range("D14"))
  .Range("E17") = WSF.CountIf(Range("A1:A64"), "F " & .Range("D14"))

    Select Case .[D14]

        Case "CAD"
            .Range("D16") = WSF.Sum(Range("G12:G6"))
            .Range("F16") = WSF.Sum(Range("G12:G6"))

        Case "Bemessern"
            .Range("D16") = WSF.Sum(Range("K6:K12"))
            .Range("F16") = WSF.Sum(Range("J6:J12"))
            .Range("E16") = WSF.Sum(Range("o6:o12"))

        Case "Ausbrecher"
            .Range("D16") = WSF.Sum(Range("M6:M12"))
            .Range("E16") = WSF.Sum(Range("N6:N12"))
            .Range("F16") = WSF.Sum(Range("M6:M12"))

        Case "Laser"
            .Range("c16") = WSF.Sum(Range("L6:L12"))
            .Range("E16") = WSF.Sum(Range("o6:o12"))
            .Range("F16") = WSF.Sum(Range("L6:L12"))

        Case "Gummi"
            .Range("c16") = WSF.Sum(Range("L6:L12"))
            .Range("E16") = WSF.Sum(Range("q6:q12"))
            .Range("F16") = WSF.Sum(Range("l16:j16"))
            .Range("D16") = WSF.Sum(Range("h6:h12"))
    End Select
End With

End Sub

Hannes62a

0
Hannes62a 07.09.2011, 23:58
@Hannes62a

Und hier mal eine Version, die auch die jeweils letzte Zeile ermittelt. Da ich die große Datei nicht habe, kann das schon leicht an der Aufgabenstellung vorbei schlittern. Aber die grundsätzliche Vorgehensweise sollte passen.

Warum ist in genau einer Gummi-Zeile der Zellbezug so anders? Tippfehler?

Hannes62a

Sub dia()
Set WSF = Application.WorksheetFunction
'letzte Zeile im Block ermitteln
LZ = [h6].End(xlDown).Row

With Sheets("Vorgabe")
  .Range("c17") = WSF.CountIf(Range("A1:A64"), "R " & .Range("D14"))
  .Range("E17") = WSF.CountIf(Range("A1:A64"), "F " & .Range("D14"))

    Select Case .[D14]

        Case "CAD"
            .Range("D16") = WSF.Sum(Range("G6:G" & LZ))
            .Range("F16") = WSF.Sum(Range("G6:G" & LZ))

        Case "Bemessern"
            .Range("D16") = WSF.Sum(Range("K6:K" & LZ))
            .Range("F16") = WSF.Sum(Range("J6:J" & LZ))
            .Range("E16") = WSF.Sum(Range("O6:O" & LZ))

        Case "Ausbrecher"
            .Range("D16") = WSF.Sum(Range("M6:M" & LZ))
            .Range("E16") = WSF.Sum(Range("N6:N" & LZ))
            .Range("F16") = WSF.Sum(Range("M6:M" & LZ))

        Case "Laser"
            .Range("c16") = WSF.Sum(Range("L6:L" & LZ))
            .Range("E16") = WSF.Sum(Range("O6:O" & LZ))
            .Range("F16") = WSF.Sum(Range("L6:L" & LZ))

        Case "Gummi"
            .Range("c16") = WSF.Sum(Range("L6:L" & LZ))
            .Range("E16") = WSF.Sum(Range("Q6:Q" & LZ))
            .Range("F16") = WSF.Sum(Range("l16:j16")) ' Hups, andere Bezüge??? Hier plötzlich nur innerhalb einer Zeile. Absicht?
            .Range("D16") = WSF.Sum(Range("H6:H" & LZ))
    End Select
End With

End Sub

0
jumbo125 08.09.2011, 00:47
@Hannes62a

Danke an alle,

ja es waren och ein paar tippfehler die ich auch noch ändern musste.

'letzte Zeile im Block ermitteln LZ = [h6].End(xlDown).Row

was genau bewirkt das? wird jetzt automatisch immer die letzte Zeile in der Tabelle genommen, auch wenn diese neu eingefügt wird??

0
jumbo125 08.09.2011, 01:44
@jumbo125

code ist mir schon klar, war ne blöde frage, selbst für einen Anfänger... ups

0
jumbo125 08.09.2011, 15:44
@jumbo125

damit man zeilen einfügen kann und die werte trotzdem in der richtigen Zelle sind, habe ich direkt unterhalb der letzten Zeile in der Spalte D das wort "check" in weiß geschrieben. Direkt unterhalb des Wort "check"(check = D13), liegt "D14"(eine der wichtigsten Zellen) Wenn ich nun eine leere Zeile einfüge wäre d14 nicht mehr d14 sondern d15. Um dem Makro diesen Fehler auszubessern lasse ich die Spalte nach dem Wort chek absuchen.(das bis dato auf in Zelle D13 lag) Füge ich nun die leere Zeile ein, liegt "check" auf D14. Das findet die Spaltensuche heraus und rechnet "1" dazu und schon hab ich Die wichtige Zelle(D14) die nun D15 ist.

ich hoffe das ist klar verständlich. Das alles mache ich mit den restlichen wichtigen Zellen ebenfalls, immer ausgehend davon, wovon sich die Zelle mit dem Wert "check'" zurzeit befindet.

das ganze sieht dan so aus: Sub dia() Set WSF = Application.WorksheetFunction 'letzte Zeile im Block ermitteln Dim strFind As String Dim c As Range Dim Zeile Dim nummer As Integer

strFind = "check"
With Worksheets("Vorgabe").Range("D" & Range("D100") _
.End(xlUp).Row, Cells(1, Range("IV1").End(xlToLeft).Column))
    Set c = .Find(strFind)
    If Not c Is Nothing Then
         nummer = c.Row

End If
End With

Dim abstand As Integer
Dim abstand1 As Integer
Dim rechnen As Integer
Dim rechnen1 As Integer
Dim zb16 As String
Dim zc16 As String
Dim ze16 As String
Dim zf16 As String
Dim zd16 As String
Dim zc17 As String
Dim ze17 As String


Dim NeuDrop As String
Dim Abstand2 As Integer
Dim Drop As Integer

abstand = 3
abstand1 = 4
rechnen = WorksheetFunction.Sum(abstand + nummer)
rechnen1 = WorksheetFunction.Sum(abstand1 + nummer)
zb16 = "B" & rechnen
zc16 = "C" & rechnen
ze16 = "E" & rechnen
zf16 = "F" & rechnen
zd16 = "D" & rechnen
zc17 = "C" & rechnen1
ze17 = "E" & rechnen1

Abstand2 = 1
Drop = WorksheetFunction.Sum(Abstand2 + nummer)
NeuDrop = "d" & Drop

MsgBox (nummer)
MsgBox (zc16)
MsgBox (NeuDrop)



With Sheets("Vorgabe")
  .Range(zc17) = WSF.CountIf(Range("A1:A64"), "R " & .Range(NeuDrop))
  .Range(ze17) = WSF.CountIf(Range("A1:A64"), "F " & .Range(NeuDrop))

    Select Case .[NeuDrop]

        Case "CAD"
            .Range(zd16) = WSF.Sum(Range("G6:G" & LZ))
            .Range(zf16) = WSF.Sum(Range(zd16))
            .Range(ze16) = "-"
            .Range(zc16) = "-"
            .Range(zb16) = "CAD"

        Case "Bemessern"
            .Range(zd16) = WSF.Sum(Range("j6:j" & LZ))
            .Range(zf16) = WSF.Sum(Range("c16:d16"))
            .Range(ze16) = WSF.Sum(Range("O6:O" & LZ))
            .Range(zc16) = WSF.Sum(Range("k6:k" & LZ))
            .Range(zb16) = "Bemessern"


        Case "Ausbrecher"
            .Range(zd16) = WSF.Sum(Range("M6:M" & LZ))
            .Range(ze16) = WSF.Sum(Range("N6:N" & LZ))
            .Range(zf16) = WSF.Sum(Range(zd16))
            .Range(zc16) = "-"
            .Range(zb16) = "Ausbrecher"

        Case "Laser"
            .Range(zc16) = WSF.Sum(Range("i6:i" & LZ))
            .Range(ze16) = WSF.Sum(Range("O6:O" & LZ))
            .Range(zf16) = WSF.Sum(Range(zc16))
            .Range(zd16) = "-"
            .Range(zb16) = "Laser"


        Case "Gummi"
            .Range(zc16) = WSF.Sum(Range("i6:i" & LZ))
            .Range(ze16) = WSF.Sum(Range("Q6:Q" & LZ))
            .Range(zf16) = WSF.Sum(Range("c16:d16")) ' Hups, andere Bezüge??? Hier plötzlich nur innerhalb einer Zeile. Absicht?
            .Range(zd16) = WSF.Sum(Range("H6:H" & LZ))
            .Range(zb16) = "Gummierung"
    End Select
End With
End Sub

nur leiter kommt dann eine Fehlermeldung: Laufzeitfehler 13, Typen unverträglich und zwar in dieser Zeile > Case "CAD"

die msgbox dinet nur zum überprüfen der Werte, keine Ahnung ob das im VBA so ülich ist, aber ansonstn verliere ich den überlick

danke für eure hilfe

0
jumbo125 08.09.2011, 18:27
@jumbo125

leider anstatt leiter... Blöde Tippfehler

Möchte mich nochmals für eure großartige Hilfe bedanken. Das mit großen Kanonen auf kleine Spatzen geschossen wird, fällt mir nun auch immer mehr ein. Einfach ins balue geraten, würde man vermutlich mit Wenn() funktionen übereinkommen.

0
Hannes62a 09.09.2011, 11:51
@jumbo125

Versuch mal statt

Select Case .[NeuDrop]

Select Case .Range(NeuDrop)

Die verkürzte Schreibweise funktioniert nicht mit Variablen.

Hannes62a

0

Versuch mal statt

Select Case .[NeuDrop]

Select Case .Range(NeuDrop)

Die verkürzte Schreibweise funktioniert nicht mit Variablen.

Hannes62a

Was möchtest Du wissen?