13. september 2007 - 20:35Der er
7 kommentarer og 1 løsning
Mulighed for at finde korresponderede tal
Forestil dig følgende data. Kolonne A indeholder data om start af et interval. Kolonne B indeholder data om slut af et interval. Kolonne C indeholder 1 tal, som skal sammenlignes med intervallerne. Kolonne D indeholder 1 tal, som skal placeres ud for det interval som kollone C's tal svarer til.
Tricket er at der kan være flere tal i kollonne C som har det samme interval, og derfor skal placeringen af kollone D værdierne kunne samles i 1 felt med et semikolon imellem.
Jeg har tænkt over om jeg kunne gøre det med et vloopup, men kan ikke få det til at fungere, fordi jeg reelt bliver nødt til at lave en monster if sætning for overhovedet at finde ud af hvor tallet i kolonne C hører til. Nogen der kender til en nemmere måde at gøre det på?
Eksempel: Kolonne A Kolonne B Kolonne C Kolonne D 1 2 3.4 112 2.1 3 1.2 95 3.1 4 2.1 86 4.1 5 2.2 72
Resultatet skulle gerne komme til at se således ud. Kolonne A Kolonne B Kolonne C Kolonne D Kollone E 1 2 3.4 112 95 2.1 3 1.2 95 86;72 3.1 4 2.1 86 112 4.1 5 2.2 72 False
Altså placer Kolonne D tallene ud for det interval som kolonne C svarer til.
Der er max point til den der klarer det.. for jeg er kørt fuldstændigt fast.. eneste løsning jeg kan tænke på er en kæmpe IF sætning kombineret med noget vlookup og text merge.
kabak: hvis vi fokuserer på 95 og derefter tallet til venstre 1.2 så skal vi finde den linie hvor intervallet 1.2 ligger inden for nemlig linie 1, fordi 1.2 passer i intervallet 1 til 2 derfor skal 95 stå i linie 1 meen derfra og til den færdige løsning !!!! held og lykke :-)
Sub Makro1() Dim Res() As Variant, Data As Variant Dim I As Long, X As Long
Data = Range("A1:D" & Range("A65536").End(xlUp).Row) ReDim Res(UBound(Data))
For I = 1 To UBound(Data)
For X = 1 To UBound(Data)
If Data(X, 3) >= Data(I, 1) And Data(X, 3) <= Data(I, 2) Then
If IsEmpty(Res(I - 1)) Then Res(I - 1) = Data(X, 4) Else Res(I - 1) = Res(I - 1) & ";" & Data(X, 4) End If
End If Next
Next For I = 0 To UBound(Res) - 1 If IsEmpty(Res(I)) Then Res(I) = False Next Range("E1:E" & UBound(Res)) = Application.WorksheetFunction.Transpose(Res) End Sub
Function Test(rk) Application.Volatile For t = 1 To 4 If Cells(t, 3) >= Cells(rk, 1) And Cells(t, 3) <= Cells(rk, 2) Then X = X & Cells(t, 4) & ";" Next If Right(X, 1) = ";" Then X = Left(X, Len(X) - 1) If X = False Then X = Empty Test = X End Function
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
