Dansk Regneark Forum
  Hjælp Hjælp  Søg i forum   Arrangementer   Opret ny bruger Opret ny bruger  Log ind Log ind


Emne lukketBetinget formattering af rækker
 Besvar Besvar
Forfatter
  Emne Søg Emne Søg  Emne funktioner Emne funktioner
PI Se dropdown
Sølv bruger
Sølv bruger
Avatar

Medlem: 07.Mar.2011
Status: Offline
Point: 294 		Direkte link til dette indlæg Emne: Betinget formattering af rækker
    Sendt: 24.Jan.2012 kl. 19:36
Hej Forum!
 
Er der nogen som kan kode en komando til at styre et arks rækkehøjde betinget af en værdi i en celle i et andet ark?
 
Her er et eksempel:
Når G72 i Ark1 = "" skal højden på rækkerne 7:13 = 0.
Når G72 i Ark1 > "" skal højden på rækkerne 7:13 = 12.
 
Jeg forventer at komandoen skal indsættes i det omhandlende arks VBA.
Mvh. PI / Excel 2010
Til top



Til top
PI Se dropdown
Sølv bruger
Sølv bruger
Avatar

Medlem: 07.Mar.2011
Status: Offline
Point: 294 		Direkte link til dette indlæg Sendt: 24.Jan.2012 kl. 19:39
Hej Forum!
 
Her er eksemplet lidt mere præciseret.
 
Når G72 i Ark1 = "", skal højden på rækkerne 7:13 i Ark 2 = 0.
Når G72 i Ark1 > "", skal højden på rækkerne 7:13 i Ark 2 = 12.
Mvh. PI / Excel 2010
Til top
rassten Se dropdown
Guld bruger
Guld bruger


Medlem: 26.Okt.2010
Status: Offline
Point: 694 		Direkte link til dette indlæg Sendt: 24.Jan.2012 kl. 21:33
Højreklik på det pågældende Ark, vælg "vis programkode"
indsæt kode

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
 If Target.Address = "$G$72" Then
 
    If Target.Value = "" Then Rows("7:13").RowHeight = 0
    If Target.Value <> "" Then Rows("7:13").RowHeight = 12
 
 End If
 
End Sub

Kode tjekker hele tiden om der er sket noget i celle G72, afhængig om den er tom eller ikke tom skjules rækkerne 7 til 13.
Bemærk at koden vil fejle hvis du eksempelvis slette flere celler hen over celle G72, for så er det ikke celle G72 men et område som der sker noget ved.
VH rassten

Arbejde excel 2010
Privat excel 2010
Til top
PI Se dropdown
Sølv bruger
Sølv bruger
Avatar

Medlem: 07.Mar.2011
Status: Offline
Point: 294 		Direkte link til dette indlæg Sendt: 25.Jan.2012 kl. 16:52
Hej Rassten
 
Tak for koden. Jeg har tilrettet og implementeret den som den ser ud nedenfor:
 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
 If Target.Address = "'STAMDATA'!$G$72" Then
 
    If Target.Value = "-" Then Rows("19:34").RowHeight = 0
    If Target.Value <> "-" Then Rows("19:34").RowHeight = 14.25
 
 End If
 
End Sub
 
Linjehøjderne bliver imidlertid ikke ændrede i højden. Den eneste effekt koden har er at der forsvinder en af teksterne i en af de rækker som jeg forsøger at formindske. Kan den manglende funktion af koden være forårsaget af at jeg har en version 2003?
Mvh. PI / Excel 2010
Til top
PI Se dropdown
Sølv bruger
Sølv bruger
Avatar

Medlem: 07.Mar.2011
Status: Offline
Point: 294 		Direkte link til dette indlæg Sendt: 25.Jan.2012 kl. 17:01
Hej Rassten!
 
Jeg har testet koden, og fundet at den er ok hvis cellereferencen er i samme ark som de rækker som ønskes reguleret i højden.
Jeg må derfor have anført ark+celleferencen ("'Stamdata'!$A$72") med en forkert notation i koden. Kan du hjælpe mig med skrive referencen med den korrekte notation i koden?
Mvh. PI / Excel 2010
Til top
excelent Se dropdown
Guld bruger
Guld bruger
Avatar

Medlem: 12.Apr.2011
Land: DK
Status: Offline
Point: 2171 		Direkte link til dette indlæg Sendt: 25.Jan.2012 kl. 18:06
Koden indsættes i arket hvor du ændrer på celle G72
Ret i koden "Ark2" til aktuel arknavn hvor koden skal ændre rækkehøjde
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G72")) Is Nothing Then Exit Sub
 If Target.Value = "-" Then Sheets("Ark2").Rows("19:34").RowHeight = 0
 If Target.Value <> "-" Then Sheets("Ark2").Rows("19:34").RowHeight = 14.25
End Sub
Til top
PI Se dropdown
Sølv bruger
Sølv bruger
Avatar

Medlem: 07.Mar.2011
Status: Offline
Point: 294 		Direkte link til dette indlæg Sendt: 25.Jan.2012 kl. 21:15
Hej Excelent!
 
Koden virker perfekt.
Jeg har imidlertid forsøgt at udbygge den ved at kopiere koden serielt, men det fungerer ikke. Jeg har indkopieret koden nedenfor.
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G41")) Is Nothing Then Exit Sub
 If Target.Value = "2" Then Sheets("Fotos").Rows("19:34").RowHeight = 14.25
 If Target.Value <> "2" Then Sheets("Fotos").Rows("19:34").RowHeight = 0
 
If Intersect(Target, Range("H41")) Is Nothing Then Exit Sub
 If Target.Value = "3" Then Sheets("Fotos").Rows("35:50").RowHeight = 14.25
 If Target.Value <> "3" Then Sheets("Fotos").Rows("35:50").RowHeight = 0
 
If Intersect(Target, Range("I41")) Is Nothing Then Exit Sub
 If Target.Value = "4" Then Sheets("Fotos").Rows("51:66").RowHeight = 14.25
 If Target.Value <> "4" Then Sheets("Fotos").Rows("51:66").RowHeight = 0
 
If Intersect(Target, Range("J41")) Is Nothing Then Exit Sub
 If Target.Value = "5" Then Sheets("Fotos").Rows("67:82").RowHeight = 14.25
 If Target.Value <> "5" Then Sheets("Fotos").Rows("67:82").RowHeight = 0
 
If Intersect(Target, Range("K41")) Is Nothing Then Exit Sub
 If Target.Value = "6" Then Sheets("Fotos").Rows("83:98").RowHeight = 14.25
 If Target.Value <> "6" Then Sheets("Fotos").Rows("83:98").RowHeight = 0
 
If Intersect(Target, Range("L41")) Is Nothing Then Exit Sub
 If Target.Value = "7" Then Sheets("Fotos").Rows("99:114").RowHeight = 14.25
 If Target.Value <> "7" Then Sheets("Fotos").Rows("99:114").RowHeight = 0
 
If Intersect(Target, Range("M41")) Is Nothing Then Exit Sub
 If Target.Value = "8" Then Sheets("Fotos").Rows("115:130").RowHeight = 14.25
 If Target.Value <> "8" Then Sheets("Fotos").Rows("115:130").RowHeight = 0
If Intersect(Target, Range("N41")) Is Nothing Then Exit Sub
 If Target.Value = "9" Then Sheets("Fotos").Rows("131:146").RowHeight = 14.25
 If Target.Value <> "9" Then Sheets("Fotos").Rows("131:146").RowHeight = 0
 
If Intersect(Target, Range("O41")) Is Nothing Then Exit Sub
 If Target.Value = "10" Then Sheets("Fotos").Rows("147:162").RowHeight = 14.25
 If Target.Value <> "10" Then Sheets("Fotos").Rows("147:162").RowHeight = 0
 
If Intersect(Target, Range("P41")) Is Nothing Then Exit Sub
 If Target.Value = "11" Then Sheets("Fotos").Rows("163:178").RowHeight = 14.25
 If Target.Value <> "11" Then Sheets("Fotos").Rows("163:178").RowHeight = 0
 
If Intersect(Target, Range("Q41")) Is Nothing Then Exit Sub
 If Target.Value = "12" Then Sheets("Fotos").Rows("179:194").RowHeight = 14.25
 If Target.Value <> "12" Then Sheets("Fotos").Rows("179:194").RowHeight = 0
 
If Intersect(Target, Range("R41")) Is Nothing Then Exit Sub
 If Target.Value = "13" Then Sheets("Fotos").Rows("195:210").RowHeight = 14.25
 If Target.Value <> "13" Then Sheets("Fotos").Rows("195:210").RowHeight = 0
 
If Intersect(Target, Range("S41")) Is Nothing Then Exit Sub
 If Target.Value = "14" Then Sheets("Fotos").Rows("211:226").RowHeight = 14.25
 If Target.Value <> "14" Then Sheets("Fotos").Rows("211:226").RowHeight = 0
 
If Intersect(Target, Range("T41")) Is Nothing Then Exit Sub
 If Target.Value = "15" Then Sheets("Fotos").Rows("227:242").RowHeight = 14.25
 If Target.Value <> "15" Then Sheets("Fotos").Rows("227:242").RowHeight = 0
 
If Intersect(Target, Range("G41")) Is Nothing Then Exit Sub
 If Target.Value = "2" Then Sheets("Eftersynsdata").Rows("22:27").RowHeight = 14.25
 If Target.Value <> "2" Then Sheets("Eftersynsdata").Rows("22:27").RowHeight = 0
End Sub
Mvh. PI / Excel 2010
Til top
excelent Se dropdown
Guld bruger
Guld bruger
Avatar

Medlem: 12.Apr.2011
Land: DK
Status: Offline
Point: 2171 		Direkte link til dette indlæg Sendt: 26.Jan.2012 kl. 00:07
prøv:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G41:T41")) Is Nothing Then Exit Sub
t_val = Target.Value: t_col = Target.Column
 If t_col = 7 And t_val = "2" Then Sheets("Eftersynsdata").Rows("22:27").RowHeight = 14.25
 If t_col = 7 And t_val <> "2" Then Sheets("Eftersynsdata").Rows("22:27").RowHeight = 0
 If t_col = 7 And t_val = "2" Then Sheets("Fotos").Rows("19:34").RowHeight = 14.25
 If t_col = 7 And t_val <> "2" Then Sheets("Fotos").Rows("19:34").RowHeight = 0
 If t_col = 8 And t_val = "3" Then Sheets("Fotos").Rows("35:50").RowHeight = 14.25
 If t_col = 8 And t_val <> "3" Then Sheets("Fotos").Rows("35:50").RowHeight = 0
 
 If t_col = 9 And t_val = "4" Then Sheets("Fotos").Rows("51:66").RowHeight = 14.25
 If t_col = 9 And t_val <> "4" Then Sheets("Fotos").Rows("51:66").RowHeight = 0
 
 If t_col = 10 And t_val = "5" Then Sheets("Fotos").Rows("67:82").RowHeight = 14.25
 If t_col = 10 And t_val <> "5" Then Sheets("Fotos").Rows("67:82").RowHeight = 0
 
 If t_col = 11 And t_val = "6" Then Sheets("Fotos").Rows("83:98").RowHeight = 14.25
 If t_col = 11 And t_val <> "6" Then Sheets("Fotos").Rows("83:98").RowHeight = 0
 
 If t_col = 12 And t_val = "7" Then Sheets("Fotos").Rows("99:114").RowHeight = 14.25
 If t_col = 12 And t_val <> "7" Then Sheets("Fotos").Rows("99:114").RowHeight = 0
 
 If t_col = 13 And t_val = "8" Then Sheets("Fotos").Rows("115:130").RowHeight = 14.25
 If t_col = 13 And t_val <> "8" Then Sheets("Fotos").Rows("115:130").RowHeight = 0
 If t_col = 14 And t_val = "9" Then Sheets("Fotos").Rows("131:146").RowHeight = 14.25
 If t_col = 14 And t_val <> "9" Then Sheets("Fotos").Rows("131:146").RowHeight = 0
 
 If t_col = 15 And t_val = "10" Then Sheets("Fotos").Rows("147:162").RowHeight = 14.25
 If t_col = 15 And t_val <> "10" Then Sheets("Fotos").Rows("147:162").RowHeight = 0
 
 If t_col = 16 And t_val = "11" Then Sheets("Fotos").Rows("163:178").RowHeight = 14.25
 If t_col = 16 And t_val <> "11" Then Sheets("Fotos").Rows("163:178").RowHeight = 0
 
 If t_col = 17 And t_val = "12" Then Sheets("Fotos").Rows("179:194").RowHeight = 14.25
 If t_col = 17 And t_val <> "12" Then Sheets("Fotos").Rows("179:194").RowHeight = 0
 
 If t_col = 18 And t_val = "13" Then Sheets("Fotos").Rows("195:210").RowHeight = 14.25
 If t_col = 18 And t_val <> "13" Then Sheets("Fotos").Rows("195:210").RowHeight = 0
 
 If t_col = 19 And t_val = "14" Then Sheets("Fotos").Rows("211:226").RowHeight = 14.25
 If t_col = 19 And t_val <> "14" Then Sheets("Fotos").Rows("211:226").RowHeight = 0
 
 If t_col = 20 And t_val = "15" Then Sheets("Fotos").Rows("227:242").RowHeight = 14.25
 If t_col = 20 And t_val <> "15" Then Sheets("Fotos").Rows("227:242").RowHeight = 0
 
End Sub
 
Til top
PI Se dropdown
Sølv bruger
Sølv bruger
Avatar

Medlem: 07.Mar.2011
Status: Offline
Point: 294 		Direkte link til dette indlæg Sendt: 26.Jan.2012 kl. 22:33
Hej Excelent!
 
Mange tak for koden. Jeg har nu udbygget den fuldt ud, og den fungerer PERFEKT! Mange tak.
 
Er du også skarp til Matrixformler?
 
Jeg har i det vedhæftede regneark, fra oven og ned, anført:
- tabel for en forespørgsel
- mellemregningstabel med matrixformel
- inddatatabel
- liste med postnumre og tilhørende by
Kan du hjælpe med de matrixformler jeg skal have indtastet i cellerne i mellemregningstabellen (celle B8:M12)?
 
Mvh. PI / Excel 2010
Til top
excelent Se dropdown
Guld bruger
Guld bruger
Avatar

Medlem: 12.Apr.2011
Land: DK
Status: Offline
Point: 2171 		Direkte link til dette indlæg Sendt: 26.Jan.2012 kl. 23:00
http://pmexcelent.dk/matrix.xls
Til top
PI Se dropdown
Sølv bruger
Sølv bruger
Avatar

Medlem: 07.Mar.2011
Status: Offline
Point: 294 		Direkte link til dette indlæg Sendt: 26.Jan.2012 kl. 23:15
Hej Excelent!
 
Mange tak for dit forslag. Jeg arbejder videre med det.
Dit pseudonym giver virkelig mening.
Mvh. PI / Excel 2010
Til top
 Besvar Besvar

Skift forum Forum tilladelser Se dropdown

© 2010 - 2024 Dansk Regneark Forum - en del af Excel-regneark.dk