Flytta område innehållande minvärde

[stealthx]

Hej!

 

Mitt problem är följande:

 

Låt oss säga att jag har ett antal områden i ett arbetsblad placerade efter varandra. Varje område innehåller ett värde jag vill söka efter ( värdena ligger placerade på samma plats i respektive område) för att jämföra dessa och ta fram minvärdet. Det område som innehåller minvärdet vill jag sen kopiera och flytta till ett nytt område i samma arbetsblad.

 

Något förslag på hur jag kan göra detta.

 

 

 

[MH2]

Vad menar du med område? Är det en rad, namngivna områden eller är det bara sammanhållna område?

Om det är samanhållna områden. Följer de någon ordning eller är de utspridda hipp som happ?

 

Lite grand att leka med. OM du använder namngivna områden.

 

[color="#0000ff"]Sub[/color] test()

[color="#0000ff"]Dim[/color] temp As Variant
[color="#0000ff"]Dim[/color] rTemp As Name
[color="#0000ff"]Dim[/color] rOmråde As Name

[color="#006400"]' Gör iordning en startpunkt[/color]
temp = [b]Application[/b].Names(1).RefersToRange.Range([GRÅ]"a1"[/GRÅ]).Offset(1, 1).Value
[color="#0000ff"]Set[/color] rTemp = [b]Application[/b].Names(1)

[color="#006400"]'Loopa igenom alla namngivna områden i boken och spara det som är minst[/color]
[color="#0000ff"]For[/color] [color="#0000ff"]Each[/color] rOmråde [color="#0000ff"]In[/color] [b]Application[/b].Names
[color="#0000ff"]If[/color] rOmråde.RefersToRange.Range([GRÅ]"a1"[/GRÅ]).Offset(1, 1).Value < temp [color="#0000ff"]Then[/color]
    temp = rOmråde.RefersToRange.Range([GRÅ]"a1"[/GRÅ]).Offset(1, 1).Value
    [color="#0000ff"]Set[/color] rTemp = rOmråde
[color="#0000ff"]End[/color] [color="#0000ff"]If[/color]
[color="#0000ff"]Next[/color] rOmråde
[color="#006400"]'Range([GRÅ]"a1"[/GRÅ]).Offset(1, 1) är bara ett sätt att ange[/color]
[color="#006400"]' den relativa positionen för ditt jämförelsevärde INNOM dit namngivna område[/color]
[color="#006400"]' Du kan lika gärna skriva [GRÅ]"B2"[/GRÅ] och strunta i offseten[/color]

rTemp.RefersToRange.Cut (Sheets([GRÅ]"Blad3"[/GRÅ]).Range([GRÅ]"C15"[/GRÅ]))
[color="#006400"]' Klip ut och klistra in det [GRÅ]"lägsta"[/GRÅ] området[/color]
[color="#0000ff"]End[/color] [color="#0000ff"]Sub[/color]

[inlägget ändrat 2006-12-19 19:31:26 av MH2]

[stealthx]

Hej, tack för svaret. Jag skall försöka förtydliga min fråga lite.

 

Med område menar jag inneslutningen av tex range("a1:j12") där värdet som jag söker är placerat på range("I11").

Nästa område är placerat direkt under det första, alltså range("a13:j24) där sökt värde är placerat i range("I23") som ska jämföras med tidigare värde.

Därefter följer ytterligare 7 områden placerade direkt under varandra i samma arbetsblad innehållandes värden som jag vill jämföra med tidigare för att hitta området innehållandes det minsta värdet.

 

Eftersom det i samma arbetsblad finns områden som jag inte vill söka igenom kan jag inte använda mig av ditt förslag där varje område söks igenom, alltså :

For Each rOmråde In application.names(1).

 

Om jag namnger de områden jag vill söka igenom med namnen Fall2071,Fall2072....Fall2079, hur skulle jag då kunna göra för att hitta området med minsta värdet.

 

[MH2]

He, He. Försöker förstå vad jag gjorde i går kväll. Inget bra betyg på min pedagogiska förmåga

Är alla områden lika stora? Dvs skulle du kunna utgå ifrån att övre vänstra hörnet ligger i

A1

A13 (A1 + 12rader)

A25 (A13 + 12rader)

 

Samma sak med ditt "kontrollområde"

i11

i 23 (i11+ 12rader)

osv? Då är det förmodligen enklare att helt enkelt utgå från det istället för att hålla på att namnge områden.

 

Exempel

 

 

 

Sub test()
Dim rTemp As Range
Dim Minst
Dim rMinst As Range

' Gör iordning en startpunkt
Set rTemp = ActiveSheet.Range("I11")
Minst = rTemp.Value

'Gå igenom var 12:e rad i I-kolumnen med
'start i I11 och kolla vilket som är minst
Do Until rTemp.Value = ""
If rTemp.Value < Minst Then
   Minst = rTemp.Value
   Set rMinst = rTemp
End If
Set rTemp = rTemp.Offset(12, 0)
Loop

Set rMinst = Range(rMinst.Offset(-11, -8), rMinst.Offset(1, 1))
' Skapar området utifrån din "kontrollcell". Dvs från
' 11 rader upp, 8 kolumner till vänster till
' en rad ner och en rad åt höger

rMinst.Cut (Sheets("Blad3").Range("A1"))
' Klip ut och klistra in det "lägsta" området
End Sub

 

[stealthx]

Tack återigen för hjälpen, det fungerar nästan nu.

 

Enda problemet är när range för området innehållandes minsta värdet ska väljas.

 

Du föreslog:

Set rMinst = Range(rMinst.Offset(-10, -8), rMinst.Offset(1, 1))

Tyvärr godtas inte detta

 

jag har försökt med lite allt möjligt bland annat med

 

Set rMinst = rMinst.Range(rMinst.Offset(-11, -8), rMinst.Offset(1, 1))

som lyckas kopiera ett område men dock inte rätt. Lyckas inte få offseten att funka med min förändring i koden

 

 

 

 

 

 

[MH2]

Märkligt. Eller kanske inte. Om det första området är minst så tilldelas ju aldrig rMinst något område (pinsamt)...

Kläm in en extra rad i början när variablerna tilldelas utgångsvärden...

 

' Gör iordning en startpunkt

Set rTemp = ActiveSheet.Range("I11")

Minst = rTemp.Value

Set rMinst = rTemp

 

Eventuellt skulle du kunna Selecta rätt blad precis i början av makrot. Bara för att vara säker på att activesheet verkligen pekar på rätt blad. Typ:

Worksheets("blad1").Select

 

 

Om du vill se vad som händer så kan du klämma in några extra meddelandeboxar precis innan du försöker göra offsetten

 

MsgBox (rMinst.Address)

Set rMinst = Range(rMinst.Offset(-11, -8), rMinst.Offset(1, 1))

MsgBox("Nytt område: " & rMinst.Address)

 

Det är helt meningslöst i ditt riktiga makro, men det är bra felsökning. För övrigt kan du använda VBA's stegläge. Om du trycker F8 inne i makrot så kan du stega igenom och se hur värdena förändras.