• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

wie kan mij helpen om de excel agenda met VBA aan te passen

Status
Niet open voor verdere reacties.
R

rvt1982

Gebruiker
Lid geworden
10 aug 2011
Berichten
156
Beste leden,

Ik samen met een paar anderen van jullie hebben samen een agenda gemaakt, alleen deze heb ik aangepast zodat ik 3 verschillende agenda's onder elkaar heb staan.

Alleen word er nog een telling gedaan (o.a. in kolom B) in agenda 1 voor alle agenda's
en zou graag willen dat elke agenda een eigen telling heeft.

dus agenda 1 is van 1b t/m 25b,
agenda 2 is van 26b t/m 44b,
agenda 3 is van 45b t/m 65b.

Maar ik krijg dit niet voor elkaar.
Wie kan mij hiermee helpen ???

ivm dat de excel bestand iets te groot is doe ik dit even via een link..
AGENDA.xls

2e link
Agenda.xls
(rechts boven aan downloaden )

Alvast bedankt.
 
Laatst bewerkt:
ik heb je bestandje geopend maar zie niet wat je wilt bereiken.

waar moet een formule komen.

wat moet deze formule doen.

wat is de uitkomst van de formule.

misschien eerst even antwoord op deze vragen.

misschien dat ik je dan kan helpen (maar misschien ook niet).
 
Ik hoop voor jou dat ik de enige ben
 

Bijlagen

  • Vastleggen in volledig scherm 16-10-2011 115120.jpg
    Vastleggen in volledig scherm 16-10-2011 115120.jpg
    35 KB · Weergaven: 94
@ Oeldere,

als je de excel opent dan zie je bij de eerste gedeelte dat "Jangeert" netjes achter Oven 1 staat (rij 5)
Maar bij Agenda 2 (waar de namen in het groen word gekleurd) staat "Piet" niet netjes achter Oven 1 (rij 30)
"Piet" staat namelijk op rij 31
En dit komt omdat 6b en 7b een telling plaats vind. en de telling geeft aan dat plaats 1 bezet is door "Jangeert" en dat "piet" op plaats 2 moet staat
dus "piet" word dus niet op rij 30 gezet maar op de 2e plaats dus rij 31.
maar gezien "piet" in de 2e agenda staat, wil ik graag dat de telling in de 2e agenda weer opnieuw begint, tevens ook voor agenda 3.

De code staat in de VBA


Code: 
Private Sub Worksheet_Activate()
Dim cl As Range, c As Variant, rij As Integer, q As Variant, nummer As Integer
 Application.ScreenUpdating = False

'Aanpassen voor het verstoppen
  Sheets("Agenda").Rows("2:2").Hidden = False
  Sheets("Agenda").Rows("4:4").Hidden = False
 
   With Sheets("Agenda").Range("B4:IQ25")
    .ClearContents
    .Interior.ColorIndex = xlNone
    .UnMerge
   End With

'Aanpassen voor de input data
With Sheets("AgendaData")
  For Each cl In .Range("a3:a" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    If cl > 0 Then

'aanpassen voor agenda
  With Sheets("Agenda")
   .Columns("B:IQ").ColumnWidth = 45
      Set c = .Range("B2:IQ2").Find(cl.Offset(, 1), LookIn:=xlValues)
   .Columns("B:IQ").ColumnWidth = 3

'aanpassen voor de machines
     rij = WorksheetFunction.Match(cl.Offset(, 2), .Range("A1:A25"), 0)
     rij = rij + .Cells(rij, c.Column - 1).CurrentRegion.Rows.Count
 
If Not c Is Nothing Then
  nummer = 0
   Do Until nummer = 24
       If .Range(c.Address).Offset(1, nummer).Value = cl.Offset(, 3) Then
   q = IIf(cl.Offset(, 4) < cl.Offset(, 3), cl.Offset(, 4) + 25 - cl.Offset(, 3), _
     cl.Offset(, 4) - cl.Offset(, 3))
  If .Cells(rij, c.Column - 1) = 1 Then
    .Cells(rij - 1, c.Column - 1).Offset(1) = 1
  Else
    .Cells(rij, c.Column - 1) = 1
  End If
      .Range(c.Address).Offset(rij - 3, nummer) = cl
        .Range(c.Address).Offset(rij - 3, nummer).HorizontalAlignment = xlVAlignCenter
         .Range(c.Address).Offset(rij - 3, nummer).Resize(, q).Merge
'kleur aanpassen
           .Range(c.Address).Offset(rij - 3, nummer).Resize(, q).Interior.ColorIndex = 3: Exit Do
         End If
        nummer = nummer + 1
      Loop
      
     End If
     End With
    End If
  Next
End With


'2e Agenda

  Sheets("Agenda").Rows("27:27").Hidden = False
  Sheets("Agenda").Rows("29:29").Hidden = False


   With Sheets("Agenda").Range("B29:IQ42")
    .ClearContents
    .Interior.ColorIndex = xlNone
    .UnMerge
   End With
With Sheets("AgendaData")
  For Each cl In .Range("g3:g" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    If cl > 0 Then
 With Sheets("Agenda")
   .Columns("B:IQ").ColumnWidth = 45
      Set c = .Range("B27:IQ27").Find(cl.Offset(, 1), LookIn:=xlValues)
   .Columns("B:IQ").ColumnWidth = 3
     rij = WorksheetFunction.Match(cl.Offset(, 2), .Range("A26:A44"), 0)
     rij = rij + .Cells(rij, c.Column - 1).CurrentRegion.Rows.Count
 
If Not c Is Nothing Then
  nummer = 0
   Do Until nummer = 24
       If .Range(c.Address).Offset(1, nummer).Value = cl.Offset(, 3) Then
   q = IIf(cl.Offset(, 4) < cl.Offset(, 3), cl.Offset(, 4) + 25 - cl.Offset(, 3), _
     cl.Offset(, 4) - cl.Offset(, 3))
  If .Cells(rij, c.Column - 1) = 1 Then
    .Cells(rij - 1, c.Column - 1).Offset(1) = 1
  Else
    .Cells(rij, c.Column - 1) = 1
  End If
      .Range(c.Address).Offset(rij - 3, nummer) = cl
        .Range(c.Address).Offset(rij - 3, nummer).HorizontalAlignment = xlVAlignCenter
         .Range(c.Address).Offset(rij - 3, nummer).Resize(, q).Merge
           .Range(c.Address).Offset(rij - 3, nummer).Resize(, q).Interior.ColorIndex = 4: Exit Do
         End If
        nummer = nummer + 1
      Loop
      
     End If
     End With
    End If
  Next
End With



'3e Agenda


    Sheets("Agenda").Rows("46:46").Hidden = False
    Sheets("Agenda").Rows("48:48").Hidden = False

   With Sheets("Agenda").Range("B48:IQ63")
    .ClearContents
    .Interior.ColorIndex = xlNone
    .UnMerge
   End With
With Sheets("AgendaData")
  For Each cl In .Range("m3:m" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    If cl > 0 Then
 With Sheets("Agenda")
   .Columns("B:IQ").ColumnWidth = 45
      Set c = .Range("B46:IQ63").Find(cl.Offset(, 1), LookIn:=xlValues)
   .Columns("B:IQ").ColumnWidth = 3
     rij = WorksheetFunction.Match(cl.Offset(, 2), .Range("A45:A63"), 0)
     rij = rij + .Cells(rij, c.Column - 1).CurrentRegion.Rows.Count
 
If Not c Is Nothing Then
  nummer = 0
   Do Until nummer = 24
       If .Range(c.Address).Offset(1, nummer).Value = cl.Offset(, 3) Then
   q = IIf(cl.Offset(, 4) < cl.Offset(, 3), cl.Offset(, 4) + 25 - cl.Offset(, 3), _
     cl.Offset(, 4) - cl.Offset(, 3))
  If .Cells(rij, c.Column - 1) = 1 Then
    .Cells(rij - 1, c.Column - 1).Offset(1) = 1
  Else
    .Cells(rij, c.Column - 1) = 1
  End If
      .Range(c.Address).Offset(rij - 3, nummer) = cl
        .Range(c.Address).Offset(rij - 3, nummer).HorizontalAlignment = xlVAlignCenter
         .Range(c.Address).Offset(rij - 3, nummer).Resize(, q).Merge
           .Range(c.Address).Offset(rij - 3, nummer).Resize(, q).Interior.ColorIndex = 6: Exit Do
         End If
        nummer = nummer + 1
      Loop
      
     End If
     End With
    End If
  Next
End With

 Application.ScreenUpdating = True
End Sub
 
@rvt1982

rob laat in z'n jpg zien, dat er geen verbinding gemaakt kan worden met jouw link.

hierdoor kan hij jouw bestand dus niet openen en je dus niet helpen.

@rvt1982
met problemen met VBA kan ik je onvoldoende helpen en dat laat ik dan ook graag aan anderen over.
 
grappig.

Ik heb het zelfde probleem met zijn jpg.
Ik zal kijken of ik deze op een andere server kan zetten.

Bedankt.

oeldere zei:
@rvt1982

rob laat in z'n jpg zien, dat er geen verbinding gemaakt kan worden met jouw link.

hierdoor kan hij jouw bestand dus niet openen en je dus niet helpen.

@rvt1982
met problemen met VBA kan ik je onvoldoende helpen en dat laat ik dan ook graag aan anderen over.
Klik om te vergroten...
 
rvt1982 zei:
Andere link:
Klik om te vergroten...

Die ook niet werkt , ook al schakel ik mijn googel account in .
Als je , je bestandje zipt is het daan ook nog te groot voor upload ?
 

Bijlagen

  • ni open.jpg
    ni open.jpg
    90,4 KB · Weergaven: 48
Laatst bewerkt:
1 zip bestand zal alsnog te groot zijn, (400 kb)
ik ga zo even kijken of ik deze in verschillende bestanden ga zippen..



trucker10 zei:
Die ook niet werkt , ook al schakel ik mijn googel account in .
Als je , je bestandje zipt is het daan ook nog te groot voor upload ?
Klik om te vergroten...
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan