Hvordan laver man en variabel array

Her er to meget ens eksempeler, på hvordan en array variable (strSheets) vokser og får tildelt sheet navne. Kan du selv tilpasse koden til dit behov?

Public Sub SmartOfficeDK_SheetsArray()
    Dim strSheets() As String
    Dim iItem As Integer
    Dim wksTemp As Worksheet
   
    iItem = 0
    ReDim strSheets(iItem)
    strSheets(iItem) = "Forside"
   
    For Each wksTemp In ThisWorkbook.Worksheets
        If UCase(Left(wksTemp.Name, 1)) = "S" Then
            iItem = iItem + 1
            ReDim Preserve strSheets(iItem)
            strSheets(iItem) = wksTemp.Name
        End If
    Next wksTemp
    Sheets(strSheets).Select
End Sub



Public Sub SmartOfficeDK_SheetsArray()
    Dim strSheets() As String
    Dim iItem As Integer
    Dim wksTemp As Worksheet
   
    iItem = -1
    For Each wksTemp In ThisWorkbook.Worksheets
        If UCase(Left(wksTemp.Name, 1)) = "S" Then
            iItem = iItem + 1
            ReDim Preserve strSheets(iItem)
            strSheets(iItem) = wksTemp.Name
        End If
    Next wksTemp
    iItem = iItem + 1
    ReDim Preserve strSheets(iItem)
    strSheets(iItem) = "Forside"

    Sheets(strSheets).Select
End Sub

Jeg kan ikke helt se hvordan jeg skal anvende disse?

For en god ordens skyld bringer jeg her hele min mailprocedure:


Public Sub SendMail()

    Dim Bund
    Dim MitRange As Variant
    Dim iMsg As Object
    Dim iConf As Object
    Dim WB2 As Workbook
    Dim WBname As String
    Dim Flds As Variant
    Dim BUTIK As String
       
    Sheets("Mail").Activate
   
    Bund = Cells(65536, 1).End(xlUp).Row
    MitRange = Range("A1:C" & Bund)
    Application.ScreenUpdating = False
    WB1Navn = ActiveWorkbook.Name
   
    a = 2
    b = 3
   
    For I = 1 To Bund
        Select Case MitRange(I, 3)
            Case 1
                a = a + 2
                b = b + 2
                Sheets(Array(1, 2, 3, a, b, "Forside")).Copy
                BUTIK = MitRange(I, 1)
                GoSub Fortsaet:
            Case 2
               

'HER STARTER UDFORDRINGEN!
'ANTAL VARIABLER I MIN ARRAY KAN VÆRE FORSKELLIG FRA GANG TIL GANG
'-----------------------------------------------------------------

'NOGLE GANG VIL MIN ARRAY F.EKS. SE SÅDAN UD:             
               
                Sheets(Array(1, 2, 3, 4, "Forside")).Copy
               
'NOGLE GANG VIL MIN ARRAY F.EKS. SE SÅDAN UD:

                Sheets(Array(1, 2, 3, 4, 5, 6, 7, "Forside")).Copy

'NOGLE GANG VIL MIN ARRAY F.EKS. SE SÅDAN UD:

                Sheets(Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, "Forside")).Copy
               


                BUTIK = MitRange(I, 1)
                GoSub Fortsaet:
        End Select
    Next I
   
GoTo Faerdig:

Fortsaet:
   
    Set WB2 = ActiveWorkbook

    ' It will save the new file with the ActiveSheet in C:/ with a Date and Time stamp
   
    WBname = WB1Navn & "_" & BUTIK & ".xls"
    WB2.SaveAs "C:/" & WBname
    WB2.Close False

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.dou.dk"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With

    With iMsg
        Set .Configuration = iConf
        .To = MitRange(I, 2)
        .CC = ""
        .BCC = ""
        .From = """Afsender"" <pd@innoteck.dk>"
        .Subject = "Test af maildistribution."
        .TextBody = "Fremsendes uden særlig følgeskrivelse."
        .AddAttachment "C:/" & WBname
        .Send
    End With

  'If you not want to delete the file you send delete this line
    Kill "C:/" & WBname
 
    Set iMsg = Nothing
    Set iConf = Nothing
    Set WB2 = Nothing
    Workbooks(WB1Navn).Activate
Return

Set WB1 = Nothing

Faerdig:
    Application.ScreenUpdating = True

End Sub

Du skriver:
'HER STARTER UDFORDRINGEN!
'ANTAL VARIABLER I MIN ARRAY KAN VÆRE FORSKELLIG FRA GANG TIL GANG

Ud fra hvilke kriterier kan du finde ud af, om det er det ene eller det andet array du skal bruge? Du må jo have et eller andet, som kan indikere det ene eller andet... eller noget der kan aflæses, så arrayet kan dannes...

Beskrivelse af problematikken:

Jeg har en rapportskabelon i Excel, som importere kundedata fra en række klienter, hvor antallet af klienter i rapporten kan variere fra gang til gang afhængigt af hvor mange (hvilke) klienter man ønsker rapporten genereret for.

I forbindelse med importen dannes 3 hovedark, som samlet lister indeholdet af rådata for de indlæste klienter. Herudover dannes for hver klient 2 ark som kun indeholder beregningsdata for hver pågældende klient. (Antalle af ark i mappen afhægnger således af antallet af indlæste klienter)

Når rapporten er dannet, skal hver klient have tilsendt de 3 hovedark sammen med deres 2 beregningsark. (Case 1 i Select Case)

Herudover skal der (til en anden modtager) yderligere sendes en samlet rapport med de 3 rådataark samt alle beregningsark (ark 4 til k, hvor k = det indlæste antal butikker x2) (Case 2 i Select Case)

Jeg kender således først antallet af variable i min array, når importen er gennemført, og de enkelte beregningsark er oprettet.

Det er ikke noget problem at løse - det er blot vigtigt at kende strukturen, så det bliver rigtigt.
Hedder alle disse ark blot et tal?
Hedder disse "rådataark" også blot tal eller ...?

De 3 rådataark har faste navne:
(f.eks. "Rådata", "Oversigt" og "Fordeling")

Beregningsark'ene får alle navn efter klienten:
(F.eks. "Rapport_Horsens", "Nøgletal_Horsens", "Rapport_Kastrup", "Nøgletal_Kastrup", "Rapport_Svendborg", "Nøgletal_Svendborg", ... osv.)

(Det kan som nævnt være forskelligt hvilke (og hvor mange) klienter der indlæses fra gang til gang.

undskyld jeg ikke er så hurtig, men fritiden er lidt knap for tiden. Jeg har ikke testet nedensåtende, men håber det viser dig ideen... (og at det virker)

    For I = 1 To Bund
        Select Case MitRange(I, 3)
            Case 1
                a = a + 2
                b = b + 2
                Sheets(Array(1, 2, 3, a, b, "Forside")).Copy
                BUTIK = MitRange(I, 1)
                GoSub Fortsaet:
            Case 2
               
' New code start
                Dim strSheets() As String
                Dim iItem As Integer
                Dim wksTemp As Worksheet
               
                iItem = 0
                ReDim strSheets(iItem)
                strSheets(iItem) = "Forside"
               
                For Each wksTemp In ThisWorkbook.Worksheets
                    If Not UCase(wksTemp.Name) Like "RÅDATA" Then
                        If Not UCase(wksTemp.Name) Like "OVERSIGT" Then
                            If Not UCase(wksTemp.Name) Like "FORDELING" Then
                                iItem = iItem + 1
                                ReDim Preserve strSheets(iItem)
                                strSheets(iItem) = wksTemp.Name
                            End If
                        End If
                    End If
                Next wksTemp
                Sheets(strSheets).Copy
' New code end

                BUTIK = MitRange(I, 1)
                GoSub Fortsaet:
        End Select
    Next I

Tak, det virker! (selvom jeg nok ikke helt endnu kan gennemskue hvordan?)

- Undskyld den lange svartid, men jeg har selv en del "skibe i søen", sååh?...
:-)

points er ihvertfald dine, og velfortjent!

Hmmm? hvorfor står mit spørgsmål fortsat åbent ("besvaret, men ikke accepteret" efter at jeg gentagne gange klikker på "Accepter"?

Du finder nok ud af, at gennemskue det :-)

Du skal vist klikke på mig først, og så klikke på accepter.