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

Filters en Sheets aanmaken met vba

Status
Niet open voor verdere reacties.
S

Senso

Meubilair
Lid geworden
13 jun 2016
Berichten
9.660
Besturingssysteem
W10 Pro en W11 Pro
Office versie
Office 2007 H@S en Office 2021 Prof Plus
In kolom A staan codenummers van grootboekrekeningen. In de andere kolommen staan de omschrijvingen en bedragen.
Voorbeelden codes:
6600
P001
A002
U344
S800
enz.
Dit zijn er zo'n 300
Nu wil ik een systeem dat automatisch sheets aanmaakt van het filter van iedere code. Vervolgens kan ik dan een keuze maken uit die sheets en selecteren en maak dan een screenshot fullscreen van die sheet. Dat laatste doe ik met GreenShot en dat gaat vrij snel.
Kan dat met vba en wie wil dat schrijven?

Bekijk bijlage Van filter naar sheets.xlsx
 
Laatst bewerkt:
Gebruik autofilter en Excels ingebouwde camera.
 
Laatst bewerkt:
Die kende ik nog niet. Dat biedt wel mogelijkheden. Dan geef ik de codes voor de benodigde filters een kleur.
 
Je kan dit gebruiken om de code naar eigen werkbladen te splitsen:
Code: 
Sub CodeNaarBlad()
    Dim wrd As Variant
    Dim i As Integer
    
    wrd = Application.Transpose(Range("A3:A18"))
    For i = 1 To UBound(wrd)
        ActiveSheet.Range("A2:C18").AutoFilter Field:=1, Criteria1:=wrd(i)
        If Not Evaluate("ISREF('" & wrd(i) & "'!A1)") Then
            ActiveSheet.Copy after:=Sheets(ThisWorkbook.Sheets.Count)
            ActiveSheet.Name = wrd(i)
        End If
        Sheets("Blad1").Activate
    Next i
    ActiveSheet.Range("A2:C18").AutoFilter Field:=1
End Sub
 
Bedankt, dat ga ik morgen proberen. Ik vind die van snb goed en ga dat eerst proberen door de betreffende code die een kleur te geven, dan weet ik ook dat ik die gehad heb.

edit:
Die van Edmoor getest en werkt perfect. Nu nog in het 'grote' document testen. Is het niet de bedoeling dat de modulenaam overeenkomt met de naam/titel in de macro?
 
Laatst bewerkt:
In het grote document krijg ik Foutmelding:
Code: 
 If Not Evaluate("ISREF('" & wrd(i) & "'!A1)") Then

De sheets worden aangemaakt maar het aantal is zo groot dat het begint te duizelen en zo is het denk ik onwerkbaar en kost veel tijd. Ik heb dan nog wel sortering van de sheets toegevoegd, maar ik moet een manier hebben snel naar de juiste sheet te gaan door bijv. het invoeren van het codenummer.
 
En zelfs Senso zegt een foutmelding te krijgen zonder deze er bij te vermelden ;)
 
Ja, dat gaat allemaal zo snel als je aan het prutsen bent, dat het niet allemaal lukt. Het is ook weer een feit, dat ik zaken tegenkom en dan denk ik dat heb ik toch een keer gezien en ik weet het niet meer! Ik moet alles tig keer doen en morgen is het weer weg. Daar moet je mee leven. Probeer het later nog wel eens.
 
fotoboek:
 

Bijlagen

  • __fotoalbum.xlsb
    18,6 KB · Weergaven: 21
Het is fout 13 tijdens uitvoering: Typen komen niet overeen.
Code: 
 If Not Evaluate("ISREF('" & wrd(i) & "'!A1)") Then

Weet nu ook hoe je snel naar het juiste tabblad gaat.

1. Bijkomende vragen. Ik heb drie 'vaste' tabbladen en die moeten aan het begin blijven staan bij de sortering. Truc > ik geef die nummer 1, 2 en 3 voor de naam. Dat heeft toch geen consequenties voor verwijzingen naar andere tabbladen?

2. Zijn modules opgenomen in VBAProject (Toolkit.xlam) in ieder Excel-bestand uitvoerbaar?

3. Moet de modulenaam niet overeenkomen met de macronaam?
 
Laatst bewerkt:
maar ik moet een manier hebben snel naar de juiste sheet te gaan door bijv. het invoeren van het codenummer.
Klik om te vergroten...


onderstaande code kan je hiervoor gebruiken.
Als je 'm aan een sneltoets hangt (bijvoorbeel Ctrl + W) kan je 'm altijd aanroepen.


Code: 
Sub GaNaarWerkblad()

Dim Q As String

Q = InputBox("Geef code in", "Ga naar werkblad")
If Q = "" Then Exit Sub
If Not Evaluate("ISREF('" & Q & "'!A1)") Then
    MsgBox "Ongeldig Werkblad", vbCritical
Else
    Sheets(Q).Activate
End If

End Sub
 
Laatst bewerkt:
Bedankt lam201 die krijg ik niet werkend maar dat geeft niet want een ander gevonden.

Als ik de macro's opneem in het lint, zie ik de icons niet meer. Waar komt dat door?

Code: 
Sub JumpToSheet()

    Dim FindName As String, FindSheet As Worksheet

    FindName = InputBox(prompt:="Enter the sheet name that you need to find", Title:=" jump to Specific Sheet ")

    For Each FindSheet In ActiveWorkbook.Worksheets

        If FindSheet.Name = FindName Then

            FindSheet.Activate

            Exit Sub

        End If

    Next

End Sub
 
Laatst bewerkt:
Foto-album is erg leuk maar met 1000 rijen en 'tig' codes onbruikbaar. Het is ook de bedoeling dat ik buiten een Excel-bestand de gegevens snel beschikbaar heb en dat doe ik met een zoekmachine. Daarom de screenshots van de sheets. Blijft nog steeds dat jouw eerst geboden oplossing Autofilter het meest praktische is.

Ik ga nog wel even door met die van Edmoor want dat is altijd leuk. Nu nog alles het in het grote document opnemen.

edit:
Alles afgerond.
 
Laatst bewerkt:
Toch even quoten...
Senso zei:
2. Zijn modules opgenomen in VBAProject (Toolkit.xlam) in ieder Excel-bestand uitvoerbaar?
Klik om te vergroten...
Dat is precies waar invoegtoepassingen voor zijn bedoeld, om code uit te voeren op gelijk welk bestand je open hebt.
Senso zei:
3. Moet de modulenaam niet overeenkomen met de macronaam?
Klik om te vergroten...
Bij voorkeur niet, de naam van de module zegt iets over het doel van die module, de naam van de sub zegt iets over wat die sub "doet". Dat zijn twee verschillende dingen. Sowieso is dezelfde naam gebruiken voor verschillende zaken nooit een goed idee.
 
Dat laatste vind ik vreemd, immers de sub voert (doet) wat in de module staat (het doel). Voor mij is het logischer dezelfde naam dan weet je waar de module voor bedoeld is (doet) en wat er in staat en wat de macro doet.
 
Modules zijn ervoor om soortgelijke macro's bij elkaar te houden.
Zo heb ik vaak een module mPrgINI waarin macro's staan die te maken hebben met initialisatie van verschillende dingen.
En een module mPrgHelp waarin macro's staan die te maken heben met het tonen van Help informatie en het laden van Help bestanden.
En nog wel meer.
 
Tsja, als er maar 1 routine in de module staat dan kan dat kloppen. Ik heb de gewoonte om de naam van alle modules te starten met "mod" en alle klasse-modules met "cls". Dan krijg je in ieder geval geen naamconflicten. Maar 1 routine in 1 module is bij mij zeldzaam.
 
@Sen

Het is handig in een gesprek gebruik te maken van argumenten.

... maar met 1000 rijen en 'tig' codes onbruikbaar.
Klik om te vergroten...
- argument(en) voor het oordeel 'onbruikbaar' ontbreekt(en).

Het is ook de bedoeling dat ik buiten een Excel-bestand de gegevens snel beschikbaar heb en dat doe ik met een zoekmachine. Daarom de screenshots van de sheets.
Klik om te vergroten...
- waar vind je die screenshots dan ?
- met welke zoekmachine moeten de screenshots gevonden worden ?
 
@Jan Karel
Niet aan gedacht, heb je gelijk aan. Jij bent een expert en werkt professioneel.

@snb
Onbruikbaar zijn op een gegeven moment als ik zaken niet meer kan overzien, het overzicht er niet meer is in het document en veel tijd kost. Eindeloos scrollen e.d. Het moet snel en sneller. Je kunt toch niet uren bezig zijn met een document.

Jij hebt mij in post 2 de snelste en een praktische oplossing geboden en die gebruik ik nu. Kan snel een filter maken en snel opslaan (met deel van bestandsnaam) en met de zoekmachine Everything heb ik het bestand (jpg of png) binnen een milliseconde en kan deze inkijken. Telkens het Excel-bestand openen kost ontzettend veel tijd.

De methode van Edmoor is de beste maar voor mij niet de meest werkbare want je moet toch nog in eerste instantie veel werk verrichten en later ben ik bang dat ik niet meer weet hoe en wat.

Opgelost en bedankt voor de hulp.:thumb:
 
Laatst bewerkt:
Je bedoelt dat je dan nog de screenshots moet maken?
Zo gaat dat helemaal automatisch:
Code: 
Sub CodeNaarBlad()
    Dim wrd As Variant
    Dim i As Integer
    
    wrd = Application.Transpose(Range("A3:A18"))
    For i = 1 To UBound(wrd)
        ActiveSheet.Range("A2:C18").AutoFilter Field:=1, Criteria1:=wrd(i)
        If Not Evaluate("ISREF('" & wrd(i) & "'!A1)") Then
            ActiveSheet.Copy after:=Sheets(ThisWorkbook.Sheets.Count)
            ActiveSheet.Name = wrd(i)
            Range2JPG
        End If
        Sheets("Blad1").Activate
    Next i
    ActiveSheet.Range("A2:C18").AutoFilter Field:=1
End Sub

Sub Range2JPG()
    Dim oChart As ChartObject
    Dim RTC As Range
    
    Set RTC = ActiveSheet.Range(ActiveSheet.UsedRange.Address)
    Application.ScreenUpdating = False
    Range(RTC.Address).CopyPicture xlScreen, xlPicture
    Set oChart = ActiveSheet.ChartObjects.Add(0, 0, RTC.Width, RTC.Height)
    oChart.Activate
    With oChart.Chart
        .Paste
        .Export ThisWorkbook.Path & "\" & ActiveSheet.Name & ".jpg", "JPG"
    End With
    oChart.Delete
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan