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

Matrix automatisch invullen

Status
Niet open voor verdere reacties.
Beste WHER, inmiddels heb ik het precies zoals ik wilde met behulp van jou UDF!!! Nu heeft excel echter moeite met het doorrekenen van alle waarden, het gaat namelijk over duizenden cellen.

De sheet waar excel zo lang bezig is met rekenen is apart van het werkdocument (waarin ik wil kunnen werken zonder steeds 15 minuten te wachten). Ik heb al uitgezet dat excel formules continu automatisch berekent, maar steeds als ik even tussendoor op wil slaan is Excel echt gewoon minimaal een kwartier verder.

Nu heb ik daar iets over gevonden op de volgende site: http://www.richardsoeteman.net/2006/08/21/InstellingenVoorAutomatischBerekenenInExcel.aspx alleen snap ik niet precies wat ik nou moet invullen in VB.

Nu zou ik dus graag de ene sheet in het excel bestand gewoon automatisch willen laten doorrekenen continu en de andere sheet (met de zware en vele formules) alleen op commando willen laten doorrekenen.

Zin om me op weg te helpen?

Alvast hardstikke bedankt! Sowieso voor de eerdere hulp!
 
Laatst bewerkt:
Probeer het eens met volgende macro achter de betrokken sheet:
Code: 
Private Sub Worksheet_Activate()
ActiveSheet.EnableCalculation = False

End Sub
 
Okey, gedaan, de sheet heet "WP" en de code ziet er nu zo uit:

Code: 
Private Sub Worksheet_Activate(WP)
'
' Berekenen Macro
'
ActiveSheet.EnableCalculation = False

End Sub

'
End Sub

Als het document nu opsla gaat ie nog steeds alles doorrekenen... (ik weet niet precies wat deze code zou moeten bereiken)
 
Laatst bewerkt door een moderator:
De eerste lijn code zou er zo moeten uit zien:
Code: 
Private Sub Worksheet_Activate()
, die "WP" hoort daar niet thuis.
Wat de code zou moeten doen spreekt nogal voor zichzelf? "EnableCalculation = False"
 
Ah kijk, dat werkt! hij gaat nu niet meer alles automatisch doorrekenen!

Nu zou ik eigenlijk met een macro de opdracht willen geven om die sheet door te rekenen
 
Laatst bewerkt door een moderator:
Is het niet eenvoudiger de ingebouwde functionaliteit hiervoor te gebruiken?
 

Bijlagen

  • Knipsel.JPG
    Knipsel.JPG
    62,1 KB · Weergaven: 42
Dat werkt niet. Ik denk dat ook die functie wordt uitgeschakeld door de ingevoerde macro achter de sheet.
 
Laatst bewerkt door een moderator:
Inderdaad, niet getest.
probeer het eens zoals in bijlage, twee buttons die om beurt EnableCalculation op en af zetten.
De eerdere macro mag dan weg.
 

Bijlagen

Ik heb Whers voorbeeld genomen met de UDF.

die tabel zet je eenvoudig (en snel !) om in gecombineerde rij/kolomkoppen met:

Code: 
Sub snb()
    sn = Cells(9, 2).CurrentRegion
    
    For j = 1 To (UBound(sn) - 1) * (UBound(sn, 2) - 1)
        y = (j - 1) \ (UBound(sn, 2) - 1) + 2
        x = (j - 1) Mod (UBound(sn, 2) - 1) + 2
        If sn(y, x) <> "" Then c01 = c01 & "|" & sn(y, 1) & sn(1, x)
    Next
    sq = Split(Mid(c01, 2), "|")
    
    Cells(20, 1).Resize(UBound(sq) + 1) = Application.Transpose(sq)
End Sub
 
Dit is hem inderdaad! bedankt!

Bestaat er n mogelijkheid om dit per kolom te bepalen in plaats van per sheet?
 
Laatst bewerkt door een moderator:
Goedemiddag,

Ik begrijp weinig van de VBA-codering en dergelijke, maar mbv jou formule doet excel er geen half uur over om alles te berekenen begrijp ik?

Mijn UDF's zien er nu als volgt uit (2 verschillende, omdat ik uiteindelijk toch rij en kolom-kop in een andere cel wilde hebben):

Code: 
Public Function Kop(rng As Range, rng2 As Range, lng As Long) As String
Dim lng2 As Long, cl As Range
With CreateObject("Scripting.Dictionary")
  For Each cl In rng
     If cl.Value = rng2.Value Then
         .Add lng2, rng(cl.Row - rng(1).Row + 1, 1).Value
         lng2 = lng2 + 1
     End If
  Next cl
Kop = .Item(lng - 1)
End With
End Function

Code: 
Public Function Kof(rng As Range, rng2 As Range, lng As Long) As String
Dim lng22 As Long, cl2 As Range
With CreateObject("Scripting.Dictionary")
  For Each cl2 In rng
     If cl2.Value = rng2.Value Then
         .Add lng22, rng(1, cl2.Column - rng(1).Column + 1).Value
         lng22 = lng22 + 1
     End If
  Next cl2
Kof = .Item(lng - 1)
End With
End Function

Ik zou graag jou suggestie willen testen, maar hoe roep ik die functie dan precies aan? Hij ziet er namelijk niet uit als UDF.....
Zou je hem om willen schrijven zodat ze hetzelfde doen als mijn eigen UDF's? (niet dat ik te lui ben om dat zelf uit te zoeken, maar dan ben ik echt een paar avonden verder zeg maar)

Alvast bedankt!
 
Laatst bewerkt door een moderator:
Wil je svp niet citeren ?
Dit is geen UDF, maar een gewone macro.
Kijk maar in de bijlage.
 

Bijlagen

Okey, ik zal niet meer citeren. Deze macro doet toch niet hetzelfde als de UDF zo ver ik kan zien, als ik van alle 2tjes 1tjes maak bijvoorbeeld veranderd er niks. Ik wil graag dat ie zoekt op 1 waarde en dat alle rij- en kolom-koppen die die waarde kruisen weergegeven worden
 
is toch gemakkelijk aan te passen ?
op waarde 1:

Code: 
Sub snb()
    sn = Cells(9, 2).CurrentRegion
    
    For j = 1 To (UBound(sn) - 1) * (UBound(sn, 2) - 1)
        y = (j - 1) \ (UBound(sn, 2) - 1) + 2
        x = (j - 1) Mod (UBound(sn, 2) - 1) + 2
        If sn(y, x) [COLOR="#FF0000"]=1[/COLOR] Then c01 = c01 & "|" & sn(y, 1) & sn(1, x)
    Next
    sq = Split(Mid(c01, 2), "|")
    
    Cells(20, 1).Resize(UBound(sq) + 1) = Application.Transpose(sq)
End Sub
 
Ja, zo te zien wel. Zoals eerder gezegd: sorry, maar ik snap weinig van de VBA-codering / taal. Nu maakt ie combinaties, graag zou ik de uitkomsten van de rijen en kolommen in verschillende cellen hebben (rood gearceerd in bijlage), en de waarde (die zojuist 1 was, in bijlage geel gearceerd) aan een cel verbinden. Zodat ik 1 t/m 150 kan invullen zonder 150 macro's te hoeven maken.

Zie bijlage.

Nogmaals: bedankt voor alle moeite!Bekijk bijlage __combinaties snb 001.xlsm
 
@Morriss Zou je willen stoppen met het onnodig quoten van berichten. Heb nu al diversen reacties van je aangepast. Je komt hier al vanaf 2008 je zou dus beter moeten weten
 
Code: 
Private Sub CommandButton1_Click()
    sn = Cells(9, 2).CurrentRegion
    
    For j = 1 To (UBound(sn) - 1) * (UBound(sn, 2) - 1)
        y = (j - 1) \ (UBound(sn, 2) - 1) + 2
        x = (j - 1) Mod (UBound(sn, 2) - 1) + 2
        If sn(y, x) = 1 Then c01 = c01 & "|" & sn(y, 1) & "_" & sn(1, x)
        If sn(y, x) = 2 Then c02 = c02 & "|" & sn(y, 1) & "_" & sn(1, x)
    Next
    
    sq = Split(Mid(c01, 2), "|")
    Cells(20, 4).Resize(UBound(sq) + 1) = Application.Transpose(sq)
    
    sq = Split(Mid(c02, 2), "|")
    Cells(20, 8).Resize(UBound(sq) + 1) = Application.Transpose(sq)
End Sub

Als je nu een beetje overtuigd geraakt bent van de voordelen van VB kun je besluiten je erin te gaan verdiepen, zodat je je volgende vragen zelf kunt gaan beantwoorden.
 
iets simpeler:

Code: 
Private Sub CommandButton1_Click()
    sn = ActiveCell.CurrentRegion
    
    For j = 1 To (UBound(sn) - 1) * (UBound(sn, 2) - 1)
        y = (j - 1) \ (UBound(sn, 2) - 1) + 2
        x = (j - 1) Mod (UBound(sn, 2) - 1) + 2
        If sn(y, x) = ActiveCell.Value Then c01 = c01 & "|" & sn(y, 1) & "_" & sn(1, x)
    Next
    sq = Split(Mid(c01, 2), "|")
    
    With Cells(ActiveCell.Row + UBound(sn) + 2, ActiveCell.Column).Resize(UBound(sq) + 1)
        .CurrentRegion.ClearContents
        .Value = Application.Transpose(sq)
        .TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:="_"
    End With
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan