Toepassen array van een bereik

[Symphysodon]

Beste forummers,

Als ik van een bereik een array maak krijg ik een foutmelding na het toepassen van handelingen met de items van de gemaakte array.

Sub vervangen()

'Verwijderen van alle eerder gemaakte rapporten
'arrEm = Array("Blad2", "Blad3", "Blad4", "Blad5")
arrEm = [a1:a4]
j = 0
For j = 0 To UBound(arrEm)
    Sheets(arrEm(j)).Delete
Next

End Sub

Ik heb de dummy site van snb over arrays bestudeerd en begrijp ook deels waarom het niet werkt maar kom nog niet tot een oplossing.
Graag advies.

 

[edmoor]

Maak er in je voorbeeld document eens dit van:

Sub vervangen()
[COLOR="#008000"]    'Verwijderen van alle eerder gemaakte rapporten
    'arrEm = Array("Blad2", "Blad3", "Blad4", "Blad5")[/COLOR]
    
    arrEm = Application.Transpose(Sheets("Blad5").Range("A1:A4"))
    Application.DisplayAlerts = False
    For j = 1 To UBound(arrEm)
        Sheets(arrEm(j)).Delete
    Next
    Application.DisplayAlerts = True
End Sub

Maar in dit geval is een loop niet nodig en variabelen ook niet:

Sub vervangen()
    Application.DisplayAlerts = False
    Sheets(Application.Transpose(Sheets("Blad5").Range("A1:A4"))).Delete
    Application.DisplayAlerts = True
End Sub

 

[Symphysodon]

natuurlijk, ik snap het.
Bedankt

 

[Symphysodon]

Kun je hier wat mee zonder voorbeeld:

    tblParameters = datawb.Sheets("Constanten").ListObjects("TBL_Inzetlijstparameters").ListColumns(1).DataBodyRange
    Criteria = Application.Transpose(tblParameters)
    Criteria = Array("Label", "Category", "Dilution Factor", "Index", "Rack Number", "Vial Numbers")
    i = 1
    j = 0
    For j = 0 To UBound(Criteria)

        Set Gevonden = rngSearch.Find(Criteria(j), , xlValues, xlWhole, xlByRows, xlNext, False)    'zoekt vanaf onder!!!
      ...

De 1e regel met Criteria.. geeft weer een foutmelding fout9 de 2e regel met Criteria.. doet het wel. Als ik tblParameters laat selecteren wordt netjes de 1e kolom van die tabel geselecteerd.
Ook als ik Application.Transpose(Application.Transpose(..)) gebruik krijg ik dezelfde foutmelding

 

[edmoor]

Niet zonder voorbeeld document.
Zet in VBA het venster lokale variabelen aan en bekijk dan de inhoud van de arrays op verschillende momenten:

 

[Symphysodon]

Top die kende ik ook nog niet.

 

[Symphysodon]

Er gaat wat meer tijd inzitten om hier een voorbeeld van te maken, de data komt van meerdere bestanden vandaan. Als ik venster lokale variabelen aanzet dan zie ik geen anomalia. Ik heb de array niet gedeclareerd, zit daar soms de crux?

Bekijk bijlage 367913

 

[edmoor]

Je bijlage doet het niet.
Plaats deze via Ga geavanceerd en dan de paperclip.

 

[Symphysodon]

Ik zie (nu) geen Ga geavanceerd? Knipsel als bijlage toegevoegd

 

[edmoor]

Zo'n plaatje kan ik niks mee.
Het enige dat ik zie is dat je bij 0 begnt met j in plaats van met 1.

 

[Symphysodon]

haha zelfs met een plaatje kom je met de oplossing. Snappen doe ik het nog niet helemaal. Ik dacht dat de ondergrens van een dimensie in een array standaard 0 is.

 

[edmoor]

Als je een array vult via een range is de basis altijd 1.
Dat kan je ook zien in dat venster met lokale variabelen.

Voor andere arrays kan je dat eventueel forceren met dit bovenin de module:

Option Base 1

 

[Symphysodon]

Bedankt :thumb:

 

[Symphysodon]

In geval van #2 er geen sheet te deleten is kun je dan volstaan met On Error Resume Next of moet ik dan iets met een foutafhandeling doen?

 

[edmoor]

Dat is dan inderdaad voldoende.
Als je een eenvoudige manier zoekt om te bepalen of een werkbblad wel of niet bestaat kan je deze functie in een module opnemen:

Function Existsheet(Bladnaam As String) As Boolean
    If Evaluate("ISREF('" & Bladnaam & "'!A1)") Then Existsheet = True
End Function

 

[Symphysodon]

Pittige materie. Ik kom er nu achter dat in mijn massa aanduidingen tekens staan die niet mogen gebruikt worden in bijv tabbladnamen. Nou dacht ik die tekens te verwijderen met replace maar ik krijg het niet voor elkaar om het resultaat in het werkblad te krijgen.

Sub aanmaak()
With Sheets("Ruwe data")
    Set tbNm = .Range([a1], [a1].End(xlToRight))
    a_sn = Application.Transpose(Application.Transpose(tbNm))
    For Each massa In a_sn
        massa = Replace(massa, "/", "")
    Next
'    For j = 1 To UBound(a_sn)
'        'On Error Resume Next
'        a_sn(j) = Replace(a_sn(j), "/", "")
'        a_sp = a_sn(j)
'
'    Next
End With
End Sub

 

[edmoor]

Wat wil je doen met die gegevens in het blad Ruwe data?
Alleen tekens toestaan die in een bladnaam mogen worden gebruikt?
Test dit dan eens:

Sub aanmaak()
    tbNm = Sheets("Ruwe data").UsedRange.Value
    For x = 1 To UBound(tbNm)
        For y = 1 To UBound(tbNm, 2)
            tbNm(x, y) = Bladnaam(tbNm(x, y))   [COLOR="#008000"]'Wijzig in array[/COLOR]
            [COLOR="#008000"]'Cells(x, y) = Bladnaam(tbNm(x, y)) [COLOR="#008000"]'Wijzig in werkblad[/COLOR][/COLOR]
            Debug.Print Bladnaam(tbNm(x, y))    [COLOR="#008000"]'Toon in direct venster[/COLOR]
        Next y
    Next x
End Sub

Function Bladnaam(ByVal Waarde As String) As String
    Teken = "/\?*:[]"
    For i = 1 To Len(teken)
        Waarde = Replace(Waarde, Mid(Teken, i, 1), "")
    Next i
    If Len(Waarde) > 31 Then Waarde = Left(Waarde, 31)
    Bladnaam = Waarde
End Function

NB:
De gegevens in dat blad zijn wat dat betreft niet representatief.

 

[Symphysodon]

De gegevens in de tabel zijn aanduidingen uit een exportbestand gegenereerd door een apparaat, van die aanduidingen worden tabbladen (rekenbladen) gemaakt en in sommige gevallen staat er een "/" in. Ik heb het ondertussen opgelost met een range ipv een array, dat werkt ook.

Super bedankt voor je hulp, erg blij mee.

 

[JEC.]

Nog een variant met Regex

Sub jec()
Debug.Print clean_string("abc/def/p*:?")
End Sub

Function clean_string(x As String) As String
 With CreateObject("vbscript.regexp")
   .Global = True
   .Pattern = "[\\/:?\*\[\]]"
   clean_string = .Replace(x, "")
 End With
End Function

 

[Symphysodon]

Edmoor en JEC bedankt.