Namen in meerdere sheets vergelijken, en waarden optellen

HSV · 3 sep 2013

Zet het bestand kokosnoot hier eens op het forum Marc.

Bij mij loopt alles als een zonnetje.

marc651 · 3 sep 2013

Bekijk bijlage Kokosnoot.xlsx Bekijk bijlage Sterren.xlsx Bekijk bijlage Tot.Opt.xlsm
Mijn pad naar de bestanden is natuurlijk anders, maar geeft hij ook geen fout aan.
Hij selecteerd ook niet de totalen van de naam die niet voorkomt in het andere bestand.

HSV · 3 sep 2013

Door je bestand "Tot Opt." mee te zenden weet ik iets meer.
In dat bestand staan nl. geen gegevens om van de andere bestanden de gegevens mee te vergelijken.

Dat wordt dus opnieuw beginnen.

Ik zal eens kijken of ik er wat van kan maken (maar wordt vandaag denk ik niet meer).

marc651 · 3 sep 2013

Aaah, nou snap ik het. Je had een soort controle-sheet in Tot.Opt.
Kan ook, maar is dat nodig?
Enigste wat ik wil hebben is de namen van verschillende mensen(met achternaam en pers.nummer) uit verschillende documenten.
Die komen dan in Tot.Opt. met daarbij de totalen van uren1 en uren2.
Dus ook als iemand maar in 1 document voorkomt.
Dus; doc.Kokosnoot Sheet.Januari + doc.Sterren Sheet.Januari komt in doc.Tot.Opt. sheet Januari.
Straks; doc.Kokosnoot Sheet.Ferbruari + doc.Sterren Sheet.Februari komt in doc.Tot.Opt. sheet Februari, enz.

HSV · 4 sep 2013

Nieuwe versie Marc.

Code:

Sub hsv()
Dim ThWb As Object, cl As Range, c As Range
Application.ScreenUpdating = False
Set ThWb = ThisWorkbook.Sheets("Totaal")
 Workbooks.Open "F:\Mijn Documenten\Rooster\kokosnoot.xlsx"
   With ActiveWorkbook
For Each cl In .Sheets("Januari").Range("A4:A" & .Sheets("Januari").Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(2)
    ThWb.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 5) = cl.Resize(, 5).Value
Next cl
ActiveWorkbook.Close False
End With
Workbooks.Open "F:\Mijn Documenten\Rooster\sterren.xlsx"
With ActiveWorkbook
For Each cl In .Sheets("Januari").Range("A4:A" & .Sheets("Januari").Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(2)
 Set c = ThWb.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
         c.Offset(, 3) = c.Offset(, 3) + cl.Offset(, 3)
         c.Offset(, 4) = c.Offset(, 4) + cl.Offset(, 4)
       End If
Else
    ThWb.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 5) = cl.Resize(, 5).Value
       End If
    Next cl
   ActiveWorkbook.Close False
 End With
End Sub

marc651 · 14 sep 2013

Hoi Harry,

Was een tijdje uit de running.
Heb je laatste code ingevoerd, en die werkt prima.
Ik heb hem gekoppeld aan een Knop.
Is het nu ook mogelijk dat de tekst op de Knop verandert, en hij dan een herberekening doet.
BV van "Berekening uitvoeren" veranderen in Opnieuw berekenen.
Als ik dit nu doe, dan zet hij dezelfde lijst onder de vorige.
Ik wil natuurlijk dat hij de boel eerst wist.

HSV · 14 sep 2013

1: Het ligt er aan wat voor knop je gebruikt, en wanneer moet het weer op "berekening uitvoeren" staan.
2: Zet de tweede regel onder de eerste in de code.

Code:

Set ThWb = ThisWorkbook.Sheets("Totaal")
ThWb.Range("A4:E" & ThWb.Cells(Rows.Count, 1).End(xlUp).Row).ClearContents

marc651 · 14 sep 2013

Bekijk bijlage Tot.Opt3.xlsm

Als ik die regel erin plak dan gooit hij een en ander door elkaar.
Begint dan een lijst te plakken vanaf A2.

Bovenstaand bestand verduidelijkt misschien wat ik wil.
Bij nader inzien hoeft de Caption van de Button toch niet verandert te worden.
Hij moet alleen een herberekening uitvoeren als er op de Button gedrukt wordt.
Nu zet hij dan een nieuwe lijst onder de oude.

HSV · 14 sep 2013

De tweede regel heb je ook niet toegevoegd zie ik.
De rode regelcode staat al in je bestand, de tweede daar ondervoegen.
Je kolommen gaan tot kolom G dus:

Code:

[COLOR=#FF0000]Set ThWb = ThisWorkbook.Sheets("Totaal")[/COLOR]
ThWb.Range("A4:G" & ThWb.Cells(Rows.Count, 1).End(xlUp).Row).ClearContents

marc651 · 14 sep 2013

Ik krijg dan dit de eerste keer als op de Button druk.

De tweede keer zet hij wel alles op de goede plek.

HSV · 14 sep 2013

Veranderen in:

Code:

ThWb.Range("A4:G" & IIf(ThWb.Cells(4, 1) = vbNullString, 4, ThWb.Cells(Rows.Count, 1).End(xlUp).Row)).ClearContents

marc651 · 14 sep 2013

Harry, dit werkt geweldig.
Hartstikke bedankt

marc651 · 3 okt 2013

Bekijk bijlage Ivk1.xlsx Bekijk bijlage Ivk.xlsm Bekijk bijlage Ivk2.xlsx

Ik heb de status toch nog op niet opgelost gezet omdat ik een aantal problemen tegen kom.
In de layout die ik gebruik krijg ik de formule niet aangepast.
Wat ik wil is in documenten Ivk1 en Ivk2 de groene reeks vergeleken en opgeteld.
Daarbij moeten alleen de waarden in kolommen D5t/mD15 bij elkaar opgeteld in Document Ivk.
Ik krijg allerlei vreemde toestanden.
Graag nog een keer wat hulp hierbij.
Misschien met wat uitleg erbij?
Ik wil later in de functie in Document Ivk ook nog meerdere documenten toevoegen.
Hoe moet dit?

HSV · 3 okt 2013

Als er onderaan in blad 'Ort Januari' nog gegevens staan, wordt....

Code:

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

.....een geheel ander bereik dan gewenst.
Vervang daar het bereik dat je wilt.

marc651 · 3 okt 2013

En doe ik dat door de Range te veranderen in...
<Range("A5:A15"............>
Zodat hij alleen dit bereik vergelijkt?

Als ik dat doe, zet hij de boel dan kriskras over mijn sheet, en kopieert ook mijn teksten boven de kolommen.

HSV · 3 okt 2013

Heb je het zo staan?

Code:

For Each cl In .Sheets("ORT Januari").Range("A4:A15").SpecialCells(2)

marc651 · 4 okt 2013

Stond bij mij nog een en ander tussen.
Aangepast, en hij doet het.

Rare is dat als er twee dezelfde voornamen zijn hij er maar een in het totaal zet.

Hoe krijg ik er nu nog een of twee(of meer) documenten bij?
Dus behlve Ivk1 en Ivk2, misschien ook Ivk3, Ivk4,enz?

Als ik het tweede deel kopieer (van Ivk2)
en daar Ivk3 van maak dan telt hij deze niet mee

HSV · 4 okt 2013

Staat er ergens een spatie achter een naam?

Het gaat over drie cellen naast elkaar.
Die moeten gelijk zijn met andere drie cellen.

Code:

If Join(Application.Index(cl.Resize(, 3).Value, 1, 0)) = _
   Join(Application.Index(c.Resize(, 3).Value, 1, 0)) Then

marc651 · 4 okt 2013

Ik heb ze gecontroleert, nergens spatie.
In Ivk2 heb ik een naam verandert in Truus Zuilen,
en in het zelfde bestand een Truus Peeters.
Die laatste haalt hij wel uit allebei de documenten, de eerste niet.

HSV · 4 okt 2013

Verander dit stuk eens tussen 'With ActiveWorkbook' en 'ActiveWorkbook.Close False'

Code:

With ActiveWorkbook
    For Each cl In .Sheets("ORT Januari").Range("A5:A15").SpecialCells(2)
 Set c = ThWb.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
         c.Offset(, 3) = c.Offset(, 3) + cl.Offset(, 3)
         c.Offset(, 4) = c.Offset(, 4) + cl.Offset(, 4)
         c.Offset(, 5) = c.Offset(, 5) + cl.Offset(, 5)
         c.Offset(, 6) = c.Offset(, 6) + cl.Offset(, 6)
   Else
 ThWb.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = cl.Resize(, 7).Value
    End If
 Else
     ThWb.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = cl.Resize(, 7).Value
       End If
    Next cl
   ActiveWorkbook.Close False

Namen in meerdere sheets vergelijken, en waarden optellen

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Wij waarderen jouw privacy