An Nepumuk !

Forumthread: 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

AW: An Nepumuk !

03.10.2005 23:18:07

Nepumuk
AW: An Nepumuk !

04.10.2005 13:19:22

Selma
AW: An Nepumuk !

05.10.2005 15:28:46

Selma
AW: An Nepumuk !

05.10.2005 16:02:52

Nepumuk
DANKESCHÖN MAX !!!

05.10.2005 16:20:18

Selma

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

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

DANKESCHÖN MAX !!!

05.10.2005 16:20:18

Selma

DANKESCHÖN MAX !!!

Beliebteste Forumthreads (12 Monate)

Forumthread: An Nepumuk !

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

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread