Giv en variabel rækker datoer navne

Kan prøve

Et navn for hver dato? - hvad er formålet?

Formålet er at lave en række strings, som jeg efterfølgende kan bruge til at hente vejrdata.

Hvor skal disse strings lagres - taler vi om variabler i selve VBA-koden eller?

Var det muligt at du kunne give et eksempel?

Ja.

Hvis brugeren som ovenfor:Startdato= 15-02-2014, og slutdato= 15-03-2014. i excel.

Så skal makroen generere alle mellemliggende datoer, for at makroen efterfølgende kan hente vejrdata for hverenkelt dato.

Jeg bruger:
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL" _
            , Destination:=Range("A10"))

og dette skal jeg så gøre for alle datoerne.
I den nuværende kode har jeg oprettet alle datoerne i excel ved hjælp af .select funktionen. Ved et loop får jeg makroen til at generere alle datoerne.

Men da makroen crasher tilfældige steder når jeg køre den, så kunne jeg godt tænke mig at køre den uden at bruge .select funktionen, da jeg har hørt at dette kan være med til at overbelaste min pc.

Ok - kunne du vise din nuværende kode?

'opretter alle datoer
Do Until Range("H4") = Range("H5")
     
    Range("G10:M11").Select
    Selection.Copy
    Selection.End(xlDown).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
Loop
           
Do Until Range("B15") = Range("B18")

'finder næste relevante dato
    Range("N7").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "x"
    ActiveCell.Offset(0, -3).Select
    Selection.Copy
    Range("C10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("N7").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -2).Select
    Selection.Copy
    Range("D10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("N7").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -1).Select
    Selection.Copy
    Range("E10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


    Dim Airport_StationID As Range
    Set Airport_StationID = Range("A10")

    Dim Airport_date_day As Range
    Set Airport_date_day = Range("C10")

    Dim Airport_date_month As Range
    Set Airport_date_month = Range("D10")

    Dim Airport_date_year As Range
    Set Airport_date_year = Range("E10")


    AIR_URL10 = "URL;http://www.wunderground.com/history/airport/"
    AIR_URL11 = Airport_StationID
    AIR_URL12 = "/"
    AIR_URL13 = Airport_date_year
    AIR_URL14 = "/"
    AIR_URL15 = Airport_date_month
    AIR_URL16 = "/"
    AIR_URL17 = Airport_date_day
    AIR_URL18 = "/"
    AIR_URL19 = "DailyHistory.html?format=1"

'laver string som skal hentes via ActiveSheet.QueryTables.Add
    Dim AIR_URL_0 As String
    AIR_URL_0 = AIR_URL10 & AIR_URL11 & AIR_URL12 & AIR_URL13 & AIR_URL14 & AIR_URL15 & AIR_URL16 & AIR_URL17 & AIR_URL18 & AIR_URL19
   

        With ActiveSheet.QueryTables.Add(Connection:= _
            AIR_URL_0 _
            , Destination:=Range("Q23"))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = False
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
Loop

Tak - vender tilbage..

Lidt klogere på "sagen" men mangler de data, der behandles i koden.
Hvis filen kan sendes er @-adressen under min profil.

Forslag:
Dim vejrStation As String, fraDato As Date, tilDato As Date, dato As Date
Public Sub beregningAfDatoer()
    Application.ScreenUpdating = False
   
Rem hent datoer fra forside
    With Sheets("Forside")
        vejrStation = .Range("D13")
        fraDato = .Range("D14")
        tilDato = .Range("D15")
    End With

Rem traverser dato-interval
    For dato = fraDato To tilDato
        opbygQuery vejrStation, Year(dato), Month(dato), Day(dato)
    Next dato
End Sub
Private Sub opbygQuery(Airport_StationID, Airport_date_year, Airport_date_month, Airport_date_day)
    AIR_URL10 = "URL;http://www.wunderground.com/history/airport/"
    AIR_URL11 = Airport_StationID
    AIR_URL12 = "/"
    AIR_URL13 = Airport_date_year
    AIR_URL14 = "/"
    AIR_URL15 = Airport_date_month
    AIR_URL16 = "/"
    AIR_URL17 = Airport_date_day
    AIR_URL18 = "/"
    AIR_URL19 = "DailyHistory.html?format=1"

'laver string som skal hentes via ActiveSheet.QueryTables.Add
    Dim AIR_URL_0 As String
    AIR_URL_0 = AIR_URL10 & AIR_URL11 & AIR_URL12 & AIR_URL13 & AIR_URL14 & AIR_URL15 & AIR_URL16 & AIR_URL17 & AIR_URL18 & AIR_URL19
   
        With ActiveSheet.QueryTables.Add(Connection:= _
            AIR_URL_0 _
            , Destination:=Range("Q23"))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = False
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
End Sub