Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
920to924
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro vereinfachen

Makro vereinfachen
04.11.2007 12:16:00
andre
Hallo
ich habe ein Problem und benötige Eure Hilfe. Ich habe ein Makro geschrieben,

Private Sub CommandButton1_Click()
If Len(Worksheets("Tabelle1").Range("D4")) > 0 Then GoTo M001
If Len(Worksheets("Tabelle1").Range("E4")) > 0 Then GoTo M002
If Len(Worksheets("Tabelle1").Range("F4")) > 0 Then GoTo M003
If Len(Worksheets("Tabelle1").Range("G4")) > 0 Then GoTo M004
If Len(Worksheets("Tabelle1").Range("H4")) > 0 Then GoTo M005
GoTo M006
M001: Worksheets("Tabelle1").Range("K4") = Worksheets("Tabelle1").Range("C4") * 12
GoTo M007
M002: Worksheets("Tabelle1").Range("K4") = Worksheets("Tabelle1").Range("C4") * 6
GoTo M007
M003: Worksheets("Tabelle1").Range("K4") = Worksheets("Tabelle1").Range("C4") * 4
GoTo M007
M004: Worksheets("Tabelle1").Range("K4") = Worksheets("Tabelle1").Range("C4") * 2
GoTo M007
M005: Worksheets("Tabelle1").Range("K4") = Worksheets("Tabelle1").Range("C4")
GoTo M007
M006: Worksheets("Tabelle1").Range("K4") = 0
M007:
End Sub


Das ist jetzt 1 "Berechnungsblock", in jedem soll der Zeilenbezug um 1 erhöht werden. Ich brauche die Berechnung für 50 Zeilen. Um nicht 50 Mal diese Makrozeilen zuschreiben lautet meine Frage:
Kann man das evtl. mit einer Schleife vereinfachen. Wie müsste die Zeilenweiterschaltung in einer Schleife aussehen?
Vielen Dank!
Viele Grüsse
Andre

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro vereinfachen
04.11.2007 12:30:09
Josef
Hallo Andre,
ungetestet.
Private Sub CommandButton1_Click()
Dim intC As Integer

With Worksheets("Tabelle1")
    For intC = 4 To 54
        If Len(.Cells(intC, 4)) > 0 Then
            .Cells(intC, 11) = .Cells(intC, 4) * 12
        ElseIf Len(.Cells(intC, 5)) > 0 Then
            .Cells(intC, 11) = .Cells(intC, 4) * 6
        ElseIf Len(.Cells(intC, 6)) > 0 Then
            .Cells(intC, 11) = .Cells(intC, 4) * 4
        ElseIf Len(.Cells(intC, 7)) > 0 Then
            .Cells(intC, 11) = .Cells(intC, 4) * 2
        ElseIf Len(.Cells(intC, 8)) > 0 Then
            .Cells(intC, 11) = .Cells(intC, 4)
        Else
            .Cells(intC, 11) = 0
        End If
    Next
End With

End Sub

Gruß Sepp

Anzeige
Korrektur
04.11.2007 12:33:00
Josef
Hallo Andre,
war ein Fehler drinn.
Private Sub CommandButton1_Click()
Dim intC As Integer

With Worksheets("Tabelle1")
    For intC = 4 To 54
        If Len(.Cells(intC, 4)) > 0 Then
            .Cells(intC, 11) = .Cells(intC, 3) * 12
        ElseIf Len(.Cells(intC, 5)) > 0 Then
            .Cells(intC, 11) = .Cells(intC, 3) * 6
        ElseIf Len(.Cells(intC, 6)) > 0 Then
            .Cells(intC, 11) = .Cells(intC, 3) * 4
        ElseIf Len(.Cells(intC, 7)) > 0 Then
            .Cells(intC, 11) = .Cells(intC, 3) * 2
        ElseIf Len(.Cells(intC, 8)) > 0 Then
            .Cells(intC, 11) = .Cells(intC, 3)
        Else
            .Cells(intC, 11) = 0
        End If
    Next
End With

End Sub


Gruß Sepp

Anzeige
AW: Korrektur
04.11.2007 13:36:44
andre
Hallo Josef,
danke für deine Mühe!
Ist genau das, was ich gesucht habe. Hat etwas gedauert, bis ich es verstanden habe.
Wieder was dazu gelernt. Ich wusste nicht, das man Zellen auf diese Art bezeichnen kann.
Gruss Andre

AW: Alternative
04.11.2007 13:58:00
Daniel
Hi
noch ne andere Möglichkeit, daß Problem zu lösen:

Sub Test()
Dim Zeile As Long
Dim x As Integer
Dim Auswahl
Auswahl = Array(0, 12, 6, 4, 2, 1)
With Worksheets("Tabelle1")
For Zeile = 4 To 54
x = 0
On Error Resume Next
x = WorksheetFunction.Match("*", .Cells(Zeile, "D").Resize(1, 5), 0)
On Error GoTo 0
.Cells(Zeile, "K").Value = .Cells(Zeile, "C").Value * Auswahl(x)
Next
End With
End Sub


Gruß, Daniel

Anzeige
AW: Alternative
04.11.2007 14:19:28
andre
Hallo Daniel,
das ist auch ein interessanter Ansatz, der auch funktioniert.
Leider ist er für mich als VBA-Anfänger nicht auf Anhieb überschaubar.
Werde ihn mir in einer ruhigen Stunde zur Brust nehmen.
Bin immer froh, etwas dazuzulernen.
Danke!
Viele Grüsse
Andre

AW: Alternative
04.11.2007 15:01:17
Daniel
Hi
um die Funktionsweise des Makros besser zu verstehen, schau dir mal diese VBA-freie, reine Formellösung für dein Problem an (bei VBA-gut solltest du damit zurecht kommen):
https://www.herber.de/bbs/user/47401.xls
ich habe versucht, diesen Ansatz per Makro nachzubilden.
in der ersten hälfte der Formeln habe ich darauf verzichtet, den Fehler abzufangen, wenn alle Zellen der Zeile leer sind, um die Formeln übersichtlich zu halten.
im 2. Teil ist das dann eingebaut.
Vielleicht ist diese Formellösung insgesamt ja besser als die Makros?
Gruß, Daniel
Anzeige

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige