Macro, welches Ergebnisse unterstreicht

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sepp,
schön, dass du dich wieder meldest. Ich habe erst jetzt verstanden, dass der thread irgendwann einmal endet und man dann keine Antwort mehr bekommt.
Zu meiner falschen Anweisung:
Du hast ja alle Konten rechnerisch abgeschlossen, indem du Excel angewiesen hast, beide Kontensummen (S-Seite und H-Seite)zu vergleichen, die größere der beiden unten zu schreiben und auf die andere Kontenseite zu übertragen. Das läuft alles Superprima.
Jetzt habe ich dich um zwei Aktionen gebeten:
1. Unterstreiche die beiden Kontensummen doppelt. Das klappt auch prima, wobei ich mir wünschen würde, dass die Doppelstriche etwas dicker sind, damit sie sich von den anderen Strichen abheben.
2. Und jetzt sofort richtig. Setze oberhalb der Kontensummen einen schwarzen Strich über die gesamte Kontenbreite.
Ich hatte formuliert:
Unterstreiche den Saldo, der ja rot eingefärbt ist, dabei habe ich aber vergessen, dass der Saldo an unterschiedlichen Stellen (Zeilen) im Konto stehen kann.
Ich habe eine liesmich Tabelle, auf der die Unterstreichungen deutlich markiert sind.
Ich bitte um Verzeihung, dass du es nachbessern musst, aber ich merke jetzt, wie genau man jeden Programmierschritt durchdenken muss.
Übrigens sind wir kurz vor dem Abschluss eines fast automatischen Kontenabschlusses.
Begleite mich doch bitte noch drei Schritte und dann ist es perfekt. Du siehst ja an dem Doppelstrich, dass Fast Endergebnisse vorliegen.
Was könnte man nun noch programmieren?
Schau bitte in die Liesmich Tabelle:
ES WÄRE NETT; WENN DU DIE CENTSPALTEN PER FORMAT IMMER MIT ZWEI ZIFFERN VERSEHEN WÜRDEST; AUCH WENN ES NUR NULLEN SIND!
Gruß
Manfred
P.S. es ist wieder Wochenende und ich sitze wieder bis mitten in der Nacht am PC
https://www.herber.de/bbs/user/46924.zip

Hallo Manfred,
die Linien sollten jetzt richtig angezeigt werden.
Sub EuroCent()
Dim rng As Range
Dim C1 As Range, C3 As Range, C4 As Range, C7 As Range, C8 As Range
Dim R34 As Long, R78 As Long, RS As Long, RK As Long, konto As Integer
Dim dbl34 As Double, dbl78 As Double, dblDiv As Double

For Each rng In Selection.Areas
    With rng
        If .Columns.Count <> 8 Then Exit For

        Set C1 = .Columns(1)
        Set C3 = .Columns(3)
        Set C4 = .Columns(4)
        Set C7 = .Columns(7)
        Set C8 = .Columns(8)

        ' RK = .Rows(1).Row - 1
        ' konto = Cells(RK, C1.Column + 1)
        ' If Right(konto, 1) = "0" Then
        ' konto = konto + 1
        ' Else
        ' konto = konto - 1
        ' End If

        R34 = .Rows(1).Row + Application.Count(C3)
        R78 = .Rows(1).Row + Application.Count(C7)
    End With

    RS = Application.Max(R34, R78)

    If RS = 1 Then Exit Sub

    dbl34 = Application.Sum(C3) + Application.Sum(C4) / 100
    dbl78 = Application.Sum(C7) + Application.Sum(C8) / 100

    dblDiv = Application.Max(dbl34, dbl78) - Application.Min(dbl34, dbl78)

    If dbl34 > dbl78 Then
        If dblDiv > 0 Then
            If RS = R78 Then RS = RS + 1
            Cells(R78, C7.Column) = Int(dblDiv)
            Cells(R78, C8.Column) = (dblDiv - Int(dblDiv)) * 100
            'Cells(R78, C7.Column - 2) = konto
            With Range(Cells(R78, C7.Column), Cells(R78, C8.Column))
                .Font.ColorIndex = 3
                .NumberFormat = "00"
            End With
        End If
        Cells(RS, C3.Column) = Int(dbl34)
        Cells(RS, C4.Column) = (dbl34 - Int(dbl34)) * 100
        Cells(RS, C7.Column) = Cells(RS, C3.Column)
        Cells(RS, C8.Column) = Cells(RS, C4.Column)
    Else
        If dblDiv > 0 Then
            If RS = R34 Then RS = RS + 1
            Cells(R34, C3.Column) = Int(dblDiv)
            Cells(R34, C4.Column) = (dblDiv - Int(dblDiv)) * 100
            'Cells(R34, C3.Column - 2) = konto
            With Range(Cells(R34, C3.Column), Cells(R34, C4.Column))
                .Font.ColorIndex = 3
                .NumberFormat = "00"
            End With
        End If
        Cells(RS, C3.Column) = Int(dbl78)
        Cells(RS, C4.Column) = (dbl78 - Int(dbl78)) * 100
        Cells(RS, C7.Column) = Cells(RS, C3.Column)
        Cells(RS, C8.Column) = Cells(RS, C4.Column)
    End If
    With Range(Cells(RS - 1, C1.Column), Cells(RS - 1, C8.Column))
        With .Borders(xlEdgeBottom)
            .ColorIndex = xlAutomatic
            .Weight = xlThick
        End With
    End With
    Range(Cells(RS, C3.Column), Cells(RS, C8.Column)).NumberFormat = "00"
    With Range(Cells(RS, C1.Column), Cells(RS, C8.Column)).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With

Next
End Sub

Das mit den Gegenkonten muss ich mir erst noch ansehen.
Das geht ja nicht so einfach, weil die ja erst nachträglich erstellt/angezeigt werden sollen.
Und da bietet die Tabelle eigentlich keinen Anhaltspunkt. Man müsste sich also für jedes Konto die Daten irgendwo zwischenspeichern um später darauf zurückgreifen zu können.
Und die Konten auf die gebucht wird müssten ja auch erst erstellt werden. Ich glaube, da wird mir der AUfwand doch zu hoch.

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Macro, welches Ergebnisse unterstreicht

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread