Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
676to680
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
676to680
676to680
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

An Nepumuk !

An Nepumuk !
03.10.2005 20:18:10
Selma
Hallo Nepumuk,
ich habe noch eine Frage/Bitte zu Beitrag https://www.herber.de/forum/messages/676068.html
Nachdem die Zeile mit grünem Hintergrund eingefügt ist würde ich gern in diese Zeile in Spalte A den Text aus der Zelle dadrüber kopieren in Spalte B den Anzahl der Zeilen bis nächste grüne Zelle im Form "Anzahl Bauteile" und in Spalte C den Text aus der Zellen dadrüber.
Könntest Du mir es bitte noch ergänzen?!
Beispieldatei wie es sein soll:

Die Datei https://www.herber.de/bbs/user/27168.xls wurde aus Datenschutzgründen gelöscht

Vielen Dank³ im Voraus....
Liebe Grüße
SELMA

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: An Nepumuk !
03.10.2005 23:18:07
Nepumuk
Hi Selma,
bitteschön:
Public Sub prcSummenzeile()
    Dim vntTemp1 As Variant, vntTemp2 As Variant
    Dim lngRow As Long, lngOldRow As Long
    Application.ScreenUpdating = False
    lngOldRow = 13
    vntTemp1 = Cells(13, 1).Value
    vntTemp2 = Cells(13, 3).Value
    For lngRow = 14 To Rows.Count
        If Cells(lngRow, 1).Value <> vntTemp1 Or Cells(lngRow, 3).Value <> vntTemp2 Then
            Rows(lngRow).Insert
            Cells(lngRow, 1).Value = Cells(lngRow - 1, 1).Value
            Cells(lngRow, 2).Value = CStr(lngRow - lngOldRow) & " Bauteil" & _
                IIf((lngRow - lngOldRow) > 1, "e", "")
            Cells(lngRow, 3).Value = Cells(lngRow - 1, 3).Value
            With Range(Cells(lngRow, 1), Cells(lngRow, 3)).Font
                .Bold = True
                .Color = vbRed
            End With
            With Cells(lngRow, 22)
                .Formula = "=Sum(" & Range(Cells(lngOldRow, 22), Cells(lngRow - 1, 22)).Address & ")"
                .Font.Bold = True
            End With
            With Cells(lngRow, 23)
                .Formula = "=Sum(" & Range(Cells(lngOldRow, 23), Cells(lngRow - 1, 23)).Address & ")"
                .Font.Bold = True
            End With
            Range(Cells(lngRow, 1), Cells(lngRow, 23)).Interior.Color = vbGreen
            vntTemp1 = Cells(lngRow + 1, 1).Value
            vntTemp2 = Cells(lngRow + 1, 3).Value
            lngRow = lngRow + 1
            lngOldRow = lngRow
        End If
        If Cells(lngRow, 1).Value = "" Then Exit For
    Next
    Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk

Anzeige
AW: An Nepumuk !
04.10.2005 13:19:22
Selma

AW: An Nepumuk !
05.10.2005 15:28:46
Selma
Hallo Max,
sorry ich habe Fehler gemacht.
Anzahl der Bauteile in Spalte B soll addiert werden aus Spalte F (bis nächste grüne Zelle von unten nach oben gesehen).
Könntest Du mir es bitte noch ändern?!
Beispieldatei wie es sein soll: https://www.herber.de/bbs/user/27231.xls
Vielen Dank³ im Voraus....
Liebe Grüße
SELMA
AW: An Nepumuk !
05.10.2005 16:02:52
Nepumuk
Hi Selma,
dann so:
Public Sub prcSummenzeile()
    Dim vntTemp1 As Variant, vntTemp2 As Variant
    Dim lngRow As Long, lngOldRow As Long
    Dim intSum As Integer
    Application.ScreenUpdating = False
    lngOldRow = 13
    vntTemp1 = Cells(13, 1).Value
    vntTemp2 = Cells(13, 3).Value
    For lngRow = 14 To Rows.Count
        If Cells(lngRow, 1).Value <> vntTemp1 Or Cells(lngRow, 3).Value _
            <> vntTemp2 Then
            Rows(lngRow).Insert
            Cells(lngRow, 1).Value = Cells(lngRow - 1, 1).Value
            intSum = WorksheetFunction.Sum(Range(Cells(lngOldRow, 6), _
                Cells(lngRow - 1, 6)))
            Cells(lngRow, 2).Value = CStr(intSum) & " Bauteil" & _
                IIf((intSum) > 1, "e", "")
            Cells(lngRow, 3).Value = Cells(lngRow - 1, 3).Value
            With Range(Cells(lngRow, 1), Cells(lngRow, 3)).Font
                .Bold = True
                .Color = vbRed
            End With
            With Cells(lngRow, 22)
                .Formula = "=Sum(" & Range(Cells(lngOldRow, 22), _
                    Cells(lngRow - 1, 22)).Address & ")"
                .Font.Bold = True
            End With
            With Cells(lngRow, 23)
                .Formula = "=Sum(" & Range(Cells(lngOldRow, 23), _
                    Cells(lngRow - 1, 23)).Address & ")"
                .Font.Bold = True
            End With
            Range(Cells(lngRow, 1), Cells(lngRow, 23)).Interior.Color = _
                vbGreen
            vntTemp1 = Cells(lngRow + 1, 1).Value
            vntTemp2 = Cells(lngRow + 1, 3).Value
            lngRow = lngRow + 1
            lngOldRow = lngRow
        End If
        If Cells(lngRow, 1).Value = "" Then Exit For
    Next
    Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk

Anzeige
DANKESCHÖN MAX !!!
05.10.2005 16:20:18
Selma
DANKESCHÖN MAX !!!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige