Returnere flere værdier

Jeg fik engang denne fra en anden bruger herinde:

Kopier denne bid ind i et modul i vba:

Public Function FindDatoer(Varenummer, Dataomrade As Range) As Variant
Application.Volatile
Data = Dataomrade
For i = 1 To UBound(Data)
If Data(i, 1) = Varenummer Then
FindDatoer = FindDatoer & Data(i, 2) & ";"
End If
Next
End Function

Function GetStrElement(s As String, n As Integer) As String
  GetStrElement = Replace(Split(s, ";")(n - 1), "", "")
End Function



Kald den ved at skrive =Finddatoer i en celle

=finddatoer(C5;Ark1!B:F)


OBS! den performer ikke super godt hvis der er rigtig data :/

Denne makro henter kun unike postnumre:

Sub HentPostNumre()
Dim LastRowColC, LastRowColB, x, k, l As Integer
Dim Temp As String
Dim y As Long
Temp = ""
LastRowColC = Range("C65536").End(xlUp).Row
LastRowColB = Sheets("Sheet2").Range("B65536").End(xlUp).Row
k = 2
For x = 2 To LastRowColC
y = Cells(x, 3)
If Application.CountIf(Sheets("Sheet2").Range("B:B"), y) > 0 Then
k = Application.Match(y, Sheets("Sheet2").Range("B:B"), 0)
For Z = 2 To LastRowColB
If Sheets("Sheet2").Cells(Z, 2) = y _
And Application.CountIf(Sheets("Sheet2").Range(Sheets("Sheet2").Cells(k, 6), _
Sheets("Sheet2").Cells(Z, 6)), Sheets("Sheet2").Cells(Z, 6)) = 1 Then
Temp = Temp & "; " & Sheets("Sheet2").Cells(Z, 6)
End If
Next
End If
If Len(Temp) > 0 Then
Temp = Right(Temp, Len(Temp) - 2)
End If
Cells(x, 4) = Temp
Temp = ""
Next
End Sub

Tak for svar.

Desværre jeg kan ingenting med vba og makro. Vil gerne forsøge mig med det, men tror det er dødsdømt projekt.

Er der slet ikke nogen andre løsninger?

Så svært er det ikke med makroer. Kopier hele makroen, højreklik på fanebladet (Ark1), vælg Vis koder og indsæt den dem. Du kan køre makroen ved at vælge Vis - Makroer - Vis makroer og så køre den derfra. Eller du kan indsætte en knap, og linke den til makroen.

En lille detalje jeg glemte: Hvad hedder dine ark? Ark1/Ark2 eller Sheet1/Sheet2? I min makro hedder de Sheet1 og Sheet2 og det skal rettes i makroen hvis dine hedder Ark1/Ark2. Jeg gør det gerne for dig, så du kan kopiere hele makroen på en gang.

Ark 1 = Postcode
Ark 2 = Sl.62

Jeg har nu udskiftet "Sheet 2" med "Sl.62" i makroen og har sat den ind - der sker dog ingenting i regnearket.

Men det ikke slutter her.
Jeg har også Ark 3, som hedder "Sl.5688" - den sat op identisk til "Sl.62"
Postnumrene fra denne ark skal hentes i ark "Postcode" i celle D30 og ned.
Dvs. at D1:D29 skal referere til "Sl.62" og D30:D59 skal referere til "Sl.5688"

Synes du stadig det kan løses med makro? Jeg må indrømme jeg er mere tilhænger af formler, så har jeg også en chance for tilpasse/rette dem hvis der opstå behov :-)

Jeg har lavet makroen om, så den kører automatisk hver gang du sætter en dato ind i kolonne C på Ark1. Kopier hele makroen og sæt den ind under vis koder (højreklik på Ark1)

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Dim LastRowColC, LastRowColB, x, k, l As Integer
Dim Temp As String
Dim y As Long
Temp = ""
Range("D2:D60").ClearContents
LastRowColB = Sheets("Sl.62").Range("B65536").End(xlUp).Row
k = 2
For x = 2 To 29
y = Cells(x, 3)
If Application.CountIf(Sheets("Sl.62").Range("B:B"), y) > 0 Then
k = Application.Match(y, Sheets("Sl.62").Range("B:B"), 0)
For Z = 2 To LastRowColB
If Sheets("Sl.62").Cells(Z, 2) = y _
And Application.CountIf(Sheets("Sl.62").Range(Sheets("Sl.62").Cells(k, 6), _
Sheets("Sl.62").Cells(Z, 6)), Sheets("Sl.62").Cells(Z, 6)) = 1 Then
Temp = Temp & "; " & Sheets("Sl.62").Cells(Z, 6)
End If
Next
End If
If Len(Temp) > 0 Then
Temp = Right(Temp, Len(Temp) - 2)
End If
Cells(x, 4) = Temp
Temp = ""
Next
Temp = ""
LastRowColB = Sheets("Sl.5688").Range("B65536").End(xlUp).Row
k = 2
For x = 30 To 59
y = Cells(x, 3)
If Application.CountIf(Sheets("Sl.5688").Range("B:B"), y) > 0 Then
k = Application.Match(y, Sheets("Sl.5688").Range("B:B"), 0)
For Z = 2 To LastRowColB
If Sheets("Sl.5688").Cells(Z, 2) = y _
And Application.CountIf(Sheets("Sl.5688").Range(Sheets("Sl.5688").Cells(k, 6), _
Sheets("Sl.5688").Cells(Z, 6)), Sheets("Sl.5688").Cells(Z, 6)) = 1 Then
Temp = Temp & "; " & Sheets("Sl.5688").Cells(Z, 6)
End If
Next
End If
If Len(Temp) > 0 Then
Temp = Right(Temp, Len(Temp) - 2)
End If
Cells(x, 4) = Temp
Temp = ""
Next
End If
End Sub

Nu lyder jeg meget dumt - hvad gør jeg for at resultatet kommer frem? :-)

Jeg har indsat makroen, som anvist. Der sker bare ingenting i ark 1 kolonne D, når jeg indtaster dato i kolonne C.

Hvad har jeg glemt?

Det er nok makrosikkerheden der er sat således at makroer ikke accepteres. Det kan du ændre under Udvikler - Makrosikkerhed. Her skal du vælge en af de tre nederste valgmuligheder. Jeg bruger selv Deaktiver alle makroer med meddelelse.

Done. Det har desværre ikke ændret noget.

Hvis det ikke er noget problem, må du gerne sende det til mig. Så vil jeg rette det til. Brug kober_soerensen(snabel-a)hotmail.com

har sendt regnearket til dig

Arket sendt retur. Problemet lå i datoen, som ikke var formateret som dato. Og makroen så den derfor som en tekststreng