• 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.

Intersecties is tabelvorm samenvatten

Status
Niet open voor verdere reacties.

Bergsma1

Gebruiker
Lid geworden
7 feb 2012
Berichten
40
Goedemiddag,

Ik begin langzaam steeds meer te leren over macro's, maar kom nog steeds veel kennis tekort om mijn problemen op te lossen.
Eerder heb ik geprobeerd met strings data samen te vatten, en deze strings te gebruiken om deze middels een macro weer te splitsen in een kolom.
Deze systematiek was een behoorlijke work-around die heden nogal wat problemen veroorzaakt.

In de bijlage een document. Op tab 1 de tabel op tab2 het format waarin het getransformeerd zou Mogen worden.
Alle lege interecties hoeven niet ingevuld te worden, alle intersecties met warden zouden getoont moeten worden.
Let wel, in mijn echte file, die te groot is om te uploaden zitten er formules achter de intersectiepunten in sommige gevallen formules en in andere gevallen gewoon harde cijfers.
het is namelijk een werkdocument waarmee ik enerzijds tracht het plan vorm te geven op basis van data, en handmatig het plan daarop bijstel of aanvul met andere gegevens.

Heeft iemand een idee hoe alle intersectiegegevens op tab 1 kunt omtoveren naar land, datum en waarde van intersectie op tab 2?

Bij voorbaat dank!

Gr
RonBekijk bijlage Problem.xlsx
 
Ron,

Met de volgende macro kun je de intersecties verzamelen.
Code:
Public Sub ZoekIntersecties()

Dim CurCell As Range
Dim nTeller As Long

With Sheets("Intersections").Range("A2")
    For Each CurCell In Sheets("Consolidation NH").Range("P34:AY74")                            'Doorloop range met intersecties
        If CurCell <> "" Then                                                                   'Als cel niet leeg is:
            .Offset(nTeller, 0) = Sheets("Consolidation NH").Range("C" & CurCell.Row).Value     'Land
            .Offset(nTeller, 1) = Sheets("Consolidation NH").Cells(8, CurCell.Column).Value     'Weeknr
            .Offset(nTeller, 2) = CurCell                                                       'Intersectie code
            .Offset(nTeller, 3) = Sheets("Consolidation NH").Range("D" & CurCell.Row).Value     'Pack
            nTeller = nTeller + 1                                                               'Volgende regel
        End If
    Next                                                                                        'Volgende cel in range met intersecties
End With
MsgBox "Intersecties overgenomen, totaal " & nTeller & " intersecties.", vbInformation, "Klaar" 'Melden dat je klaar bent.

End Sub

Veel Succes.
 
Hoi Elsendoorn2134,

Het script werkt perfect! Het is wat traag voor mijn eigenlijke datalijst maar functioneel! Ik heb t toegepast in de rest van mijn script, mijn dank!
 
Ron,

Het programma is snel genoeg maar ik vermoed dat er in je bestand nog al veel gerekend wordt.
Zet het automatisch berekenen aan het begin van de code uit, en aan het einde van de code weer aan.
Uitzetten:
Code:
Application.Calculation = xlCalculationManual
Aanzetten:
Code:
Application.Calculation = xlCalculationAutomatic

Veel Succes.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan