Namen in meerdere sheets vergelijken, en waarden optellen

marc651 · 1 sep 2013

Hoi,

Ik heb verschillende excel documenten.
Nu zoek ik een formule waarbij er bij een druk op een knop,
de naam, achternaam en het pers. nummer met elkaar vergeleken worden.
Als deze hetzelfde zijn moet hij de waarden in de cel uren1 van sheet Afd.1 en Sheet Afd.2 bij elkaar optellen in sheet Totaal.
Is dit mogelijk?
Bekijk bijlage Tot.Opt.xlsx

Groet Marc

HSV · 1 sep 2013

Test het eens Marc.

Code:

Sub hsv()
Dim cl As Range, c As Range
For Each cl In Sheets("Afd. 1").Range("A4:A" & Sheets("Afd. 1").Cells(Rows.Count, 1).End(xlUp).Row)
 Set c = Sheets("Afd. 2").Columns(1).Find(cl, , xlValues)
  If Not c Is Nothing Then
   If Join(Application.Index(cl.Resize(, 3).Value, 1, 0)) = _
   Join(Application.Index(c.Resize(, 3).Value, 1, 0)) Then
With Sheets("Totaal").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .Resize(, 3) = cl.Resize(, 3).Value
    .Offset(, 3) = cl.Offset(, 3) + c.Offset(, 3)
End With
     End If
    End If
  Next cl
End Sub

marc651 · 1 sep 2013

Harry,

Geprobeerd en werkt. Hij telt alleen uren1 op, en uren2 (of meerder uren versies die ik eventueel wil hebben) niet.
De code snap ik niet zo goed (gaat mijn VBA kennis te boven).
Controleert hij met deze functie Naam, Achternaam en pers. nummer?
Is dit ook te realiseren met twee verschillende documenten?

groet marc

HSV · 1 sep 2013

Uiteraard test het op de drie voorwaarden.

Code:

Sub hsv()
Dim cl As Range, c As Range
For Each cl In Sheets("Afd. 1").Range("A4:A" & Sheets("Afd. 1").Cells(Rows.Count, 1).End(xlUp).Row)
 Set c = Sheets("Afd. 2").Columns(1).Find(cl, , xlValues)
  If Not c Is Nothing Then
   If Join(Application.Index(cl.Resize(, 3).Value, 1, 0)) = _
   Join(Application.Index(c.Resize(, 3).Value, 1, 0)) Then
With Sheets("Totaal").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .Resize(, 3) = cl.Resize(, 3).Value
    .Offset(, 3) = cl.Offset(, 3) + c.Offset(, 3)
    .Offset(, 4) = cl.Offset(, 4) + c.Offset(, 4)
End With
     End If
    End If
  Next cl
End Sub

Met twee documenten maakt in principe geen verschil.

marc651 · 1 sep 2013

Hoi Harry,

Ik snap de toevoeging. Is zo dus ook uit te breiden naar meer.
Is mijn laatste vraag ook makkelijk aan te passen?
Als ik data uit verschillende documenten wil halen ipv verschillende sheets?

Gr Marc

HSV · 1 sep 2013

Marc,

Bv.

Code:

Sub hsv()
Dim cl As Range, c As Range
Application.ScreenUpdating = False
Workbooks.Open [COLOR=#FF0000]"C:\users\hsv\desktop\Marc.xlsx"[/COLOR]
With ThisWorkbook
For Each cl In .Sheets("Afd. 1").Range("A4:A" & .Sheets("Afd. 1").Cells(Rows.Count, 1).End(xlUp).Row)
 
 Set c = ActiveWorkbook.Sheets("Afd. 2").Columns(1).Find(cl, , xlValues)
  If Not c Is Nothing Then
   If Join(Application.Index(cl.Resize(, 3).Value, 1, 0)) = _
   Join(Application.Index(c.Resize(, 3).Value, 1, 0)) Then
With .Sheets("Totaal").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .Resize(, 3) = cl.Resize(, 3).Value
    .Offset(, 3) = cl.Offset(, 3) + c.Offset(, 3)
    .Offset(, 4) = cl.Offset(, 4) + c.Offset(, 4)
End With
     End If
    End If
  Next cl
  
  End With
 ActiveWorkbook.Close False
End Sub

marc651 · 1 sep 2013

Hoi Harry,

Vergeef me mijn onwetendheid.
Maar, hoe ziet dat er uit in een functie als ik bv 3 documenten heb met verschillende namen.
Met op elk document op sheet 3 de info die ik nodig heb?
En, herrekend hij ook als ik Control-Alt-F9 gebruik?

Gr Marc

marc651 · 2 sep 2013

Hoi Harry,

Nog als toelichting: ik werk in een netwerkomgeving. Als ik het pad naar mijn persoonlijke map intoets krijgb ik een foutmelding "fout 1004 tijdens uitvoering" Door de toepassing of door object gedefinieerde fout.
Mijn pad is:

Code:

C:\m.luijpers(F:)\mijn documenten\Rooster.xslx

Zoekt hij nu alle xslx-documenten in de map rooster?
Of moet ik elk document in een aparte regel defenieren?

marc651 · 2 sep 2013

Die smiley is een foutje, moet staan (F

marc651 · 2 sep 2013

Krijg ik weer een smiley terwijl ik een dubbele punt typ.

huijb · 2 sep 2013

Gebruik dan ook de codetag http://www.helpmij.nl/forum/showthr...-de-helpers-in-deze-sectie-van-dienst-te-zijn

marc651 · 2 sep 2013

Ben nog aan het knutselen geweest.
Ik heb nu een document genaamd "Kokosnoot" en een document genaamd "Sterren".
Vervolgens een document "Tot.Opt." waar de totalen in moeten komen te staan.
Ik heb daar de volgende code op las gelaten:

Code:

Sub hsv()
Dim cl As Range, c As Range
Application.ScreenUpdating = False
Workbooks.Open "F:\Mijn Documenten\Rooster\Kokosnoot.xlsx"
Workbooks.Open "F:\Mijn Documenten\Rooster\Sterren.xlsx"
With ThisWorkbook
    For Each cl In .Sheets("Januari").Range("A4:A" & .Sheets("Januari").Cells(Rows.Count, 1).End(xlUp).Row)
    Set c = ActiveWorkbook.Sheets("Januari").Columns(1).Find(cl, , xlValues)
    If Not c Is Nothing Then
    If Join(Application.Index(cl.Resize(, 3).Value, 1, 0)) = _
    Join(Application.Index(c.Resize(, 3).Value, 1, 0)) Then
    With .Sheets("Totaal").Cells(Rows.Count, 1).End(xlUp).Offset(1)
     .Resize(, 3) = cl.Resize(, 3).Value
     .Offset(, 3) = cl.Offset(, 3) + c.Offset(, 3)
     .Offset(, 4) = cl.Offset(, 4) + c.Offset(, 4)
 End With
      End If
     End If
   Next cl

   End With
  ActiveWorkbook.Close False
End Sub

Ik krijg hierbij de melding dat het subscript buiten het bereik valt.

HSV · 2 sep 2013

Test dit eens Marc.

Code:

Sub hsv()
Dim cl As Range, c As Range, i As Long, sName As String, Uren1 As Long, Uren2 As Long
Application.ScreenUpdating = False
With ThisWorkbook
For Each cl In .Sheets("Afd. 1").Range("A4:A" & .Sheets("Afd. 1").Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(2)
   Uren1 = 0
   Uren2 = 0
 For i = 1 To 2
  Select Case i
 Case 1
   Workbooks.Open "C:\users\hsv\desktop\kokosnoot.xlsx"
 Case 2
   Workbooks.Open "C:\users\hsv\desktop\sterren.xlsx"
End Select
 Set c = ActiveWorkbook.Sheets(3).Columns(1).Find(cl, , xlValues)
  If Not c Is Nothing Then
    If Join(Application.Index(cl.Resize(, 3).Value, 1, 0)) = _
   Join(Application.Index(c.Resize(, 3).Value, 1, 0)) Then
     sName = Join(Application.Index(cl.Resize(, 3).Value, 1, 0), "|")
     Uren1 = Uren1 + IIf(i = 1, cl.Offset(, 3) + c.Offset(, 3), c.Offset(, 3))
     Uren2 = Uren2 + IIf(i = 1, cl.Offset(, 4) + c.Offset(, 4), c.Offset(, 4))
       End If
      End If
    ActiveWorkbook.Close False
 Next i
     With .Sheets("Totaal").Cells(Rows.Count, 1).End(xlUp).Offset(1)
       .Resize(, 3) = Split(sName, "|")
       .Offset(, 3) = Uren1
       .Offset(, 4) = Uren2
     End With
  Next cl
End With
End Sub

marc651 · 2 sep 2013

Harry,

In deze versie krijg ik dezelfde foutmelding en gebeurt er verder niets.
In de vorige versie (die ik wat aangepast heb)opende hij wel de twee documenten waar naar verwezen werd voordat hij de foutmelding gaf.Als ik foutopsporing draai geeft hij de foutmelding na de volgende coderegel:

Code:

For Each cl In .Sheets("Januari").Range("A4:A" & .Sheets("Januari").Cells(Rows.Count, 1).End(xlUp).Row)

HSV · 2 sep 2013

Welke foutmelding krijg je.

marc651 · 2 sep 2013

Subscript valt buiten bereik

HSV · 2 sep 2013

Dan heeft Thisworkbook (bestand waar de code instaat) niet een werkblad met de naam "Januari".

marc651 · 3 sep 2013

Oke, er gebeurt iets.
Heb de sheetnaam verandert in "Januari".
Nog niet helemaal wat de bedoeling is.
Er verschijnt nu in de kolom "uren 1" in het document "Tot.Opt" ipv het totaal van de twee andere documenten;
"uren1uren1". in de kolom "uren 2" verschijnt "uren2uren2". Geen cijfers dus.
Ik heb hierbij de eenalaatste code ingevoerd.
Bij de laaste code gebeurt hetzelfde.
Hij opend wel netjes beide documenten. Sloot er maar een af, maar door de laatste regel te kopieren sluit hij ze nu allebei.

HSV · 3 sep 2013

Zo ziet het testbestand er uit bij mij.

Dit bestand opent het bestand "kokosnoot", haalt de gegevens op en sluit het weer.
Daarna opent het bestand "sterren" en doet hetzelfde.

De gegevns komen in het testbestand in blad "Totaaal".
.

marc651 · 3 sep 2013

Als ik dit aanpas naar mijn bestanden(Afd. 1 en Afd. 2 heb ik Kokosnoot en Sterren genoemd)
loopt hij goed tot regel 21. Daar geeft de foutmelding; "typen komen niet met elkaar overeen".

Mijn code ziet er dan zo uit;

Code:

Sub hsv()
Dim cl As Range, c As Range, i As Long, sName As String, Uren1 As Long, Uren2 As Long
Application.ScreenUpdating = False

With ThisWorkbook
For Each cl In .Sheets("Januari").Range("A4:A" & .Sheets("Januari").Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(2)
   Uren1 = 0
   Uren2 = 0
 For i = 1 To 2
  Select Case i
 Case 1
   Workbooks.Open "F:\Mijn Documenten\Rooster\Kokosnoot.xlsx"
 Case 2
   Workbooks.Open "F:\Mijn Documenten\Rooster\Sterren.xlsx"
End Select
 Set c = ActiveWorkbook.Sheets("Januari").Columns(1).Find(cl, , xlValues)
  If Not c Is Nothing Then
    If Join(Application.Index(cl.Resize(, 3).Value, 1, 0)) = _
   Join(Application.Index(c.Resize(, 3).Value, 1, 0)) Then
     sName = Join(Application.Index(cl.Resize(, 3).Value, 1, 0), "|")
     Uren1 = Uren1 + IIf(i = 1, cl.Offset(, 3) + c.Offset(, 3), c.Offset(, 3))
     Uren2 = Uren2 + IIf(i = 1, cl.Offset(, 4) + c.Offset(, 4), c.Offset(, 4))
       End If
      End If
    ActiveWorkbook.Close False
 Next i
 
    With .Sheets("Totaal").Cells(Rows.Count, 1).End(xlUp).Offset(1)
       .Resize(, 3) = Split(sName, "|")
       .Offset(, 3) = Uren1
       .Offset(, 4) = Uren2
     End With
  Next cl
End With

Ik had bij mijn eigen bestanden ook geen sheet Afd.1 in het document "Tot.Opt.".
De bovenstaande code kreeg ik niet aan het werken, en bij de voorlaatste code die je me gestuurd hebt kreeg ik het volgende;

Namen in meerdere sheets vergelijken, en waarden optellen

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Supermoderator

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Bijlagen

Gebruiker

Wij waarderen jouw privacy