subtotalen

[hapdruijts]

Heb een vrij ingewikkelde vraag. In bijgaand bestand worden dagelijks de routes aangemaakt. Nu wil ik nog een paar zaken via een macro laten verlopen.
1. Bij de Subtotalen moeten namen ingvuld worden. Dit lukt wel met vert.zoeken, maar zou graag Totaal weglaten. Kan dit? Sheet 3 staan namen die bij route's passen.

2. Wil bij elk totaal automatisch de naam in vullen dit kan met een formule. Echter nu is het besstand dagelijks anders. Dus Hoe kan ik zorgen dat hij stopt bij Eindtotaal?

3. hoe selecteer ik regel voor regel om een kleur te geven aan de regel met de totalen?

Bestand 30-11-2010 is hoe het begin is, "moet 30-11-2010"is hoe het zou moetehn worden met 1 macro.

 

[E v R]

lukt het hiermee?

Sub tst()
    Dim Cel As Range, Naam As String
    With Sheets("Dagplanning")
        For Each Cel In .Range("B3:B" & .Cells(Rows.Count, "F").End(xlUp).Row - 1)
            If Cel.Value = "" Then
                On Error Resume Next: Naam = "Geen Naam"
                Naam = Application.WorksheetFunction.VLookup(Cel.Offset(0, 4).Value, Sheets("Sheet3").Range("A1:B18"), 2, False)
                With Cel
                    .Value = Naam
                    .EntireRow.Interior.ColorIndex = 6
                    .Font.Bold = True
                End With
                Cel.Offset(0, 4).ClearContents
            End If
        Next Cel
    End With
End Sub

 

[hapdruijts]

lukt goed. Echter 1 opmerking. de naam van het subtotaal moet ook blijven staan. Kan dat?

 

[E v R]

zo:?

Sub tst()
    Dim Cel As Range, Naam As String
    With Sheets("Dagplanning")
        For Each Cel In .Range("B3:B" & .Cells(Rows.Count, "F").End(xlUp).Row - 1)
            If Cel.Value = "" Then
                On Error Resume Next: Naam = "Geen Naam"
                Naam = Application.WorksheetFunction.VLookup(Cel.Offset(0, 4).Value, Sheets("Sheet3").Range("A1:B18"), 2, False)
                With Cel
                    .Value = Naam
                    .EntireRow.Interior.ColorIndex = 6
                    .Font.Bold = True
                End With
                Cel.Offset(0, 4).Value = Replace(Cel.Offset(0, 4).Value, "Totaal ", "")
            End If
        Next Cel
    End With
End Sub

 

[hapdruijts]

ziet er perfect uit.
Echter nu heb ik nog 1 probleem.
ik draai de macro vanuit een ander bestand. En dan?

 

[hapdruijts]

en moet ik ergens een bereik een naam geven?

 

[E v R]

ziet er perfect uit.
Echter nu heb ik nog 1 probleem.
ik draai de macro vanuit een ander bestand. En dan?

Zorg wel dat het bestand openstaat,

Sub tst()
    Dim Cel As Range, Naam As String
    With [COLOR="red"]Workbooks("Hier de naam van jouw bestand.xls").[/COLOR]Sheets("Dagplanning")
        For Each Cel In .Range("B3:B" & .Cells(Rows.Count, "F").End(xlUp).Row - 1)
            If Cel.Value = "" Then
                On Error Resume Next: Naam = "Geen Naam"
                Naam = Application.WorksheetFunction.VLookup(Cel.Offset(0, 4).Value, Sheets("Sheet3").Range("A1:B18"), 2, False)
                With Cel
                    .Value = Naam
                    .EntireRow.Interior.ColorIndex = 6
                    .Font.Bold = True
                End With
                Cel.Offset(0, 4).Value = Replace(Cel.Offset(0, 4).Value, "Totaal ", "")
            End If
        Next Cel
    End With
End Sub

 

[E v R]

en moet ik ergens een bereik een naam geven?

Nee hoor, bereik wordt al in de macro aangegeven