Det virker ikke som ønsket alligevel. Listen fra E24-E523 bliver udfyldt løbende, og listen fra F1-F15 skal opdatere sig selv samtidig. Det kan jeg ikke få den til nu...? Er det bare mig, eller...? :o/
AI bliver først for alvor en del af arbejdet, når teknologien integreres i den måde, vi arbejder på. At have adgang til AI betyder ikke nødvendigvis, at medarbejderne er klar til at bruge den.
Er jeg nødt til at opdatere arket via den makro hver gang der kommer en ny værdi i kolonne E, eller sker det automatisk? Jeg vil gerne have at listen opdateres automatisk... :o/
Ja, en værdi ad gangen. Kan man ikke gøre det ved en eller anden opslags-funktion? Sådan så F1 viser den første værdi, F2 viser den næste værdi, der er forskellig fra F1 osv...?
Sæt denne kode ind i arkets modul, så opdateres den automatisk.
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("E23:E523")) Is Nothing Then Range("E23:E523").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "F1"), Unique:=True End If End Sub
Det vil sige at du har makroen Private Sub Worksheet_Change(ByVal Target As Range) i forvejen.
Find den og se om du ikke kan sætte koden ind
If Not Intersect(Target, Range("E23:E523")) Is Nothing Then Range("E23:E523").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "F1"), Unique:=True
Jeg skal faktisk bruge den her funktion 3 gange. Fra E22-E523(+overskrift) til N1-N17, fra F22-F523 til O1-O17 og fra I22-I523 til P1-P17. Her er en kopi af mit modul fra dette ark. Jeg har forsøgt at sætte koden x3 ind i modulet under:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Men det virker ikke... Måske du vil kigge på det? :o/
Private Sub CommandButton1_Click() Application.ScreenUpdating = False For t = 10 To 14 x = Cells(524, 11).End(xlUp).Row + 1 If x < 25 Then x = 25 If Cells(t, 11) <> "" Then y = Range("C" & t & ":L" & t).Value Range("C" & x & ":L" & x) = y Cells(x, 3).Value = CDate(Cells(x, 3).Value) Range("C" & t & ":L" & t).ClearContents End If Next x = Cells(524, 11).End(xlUp).Row Range("C25:L" & x).Select Selection.Sort Key1:=Range("C25"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal
For t = 10 To 14 Step 2 Range("C" & t & ":L" & t).Interior.ColorIndex = 24 Range("C" & t + 1 & ":L" & t + 1).Interior.ColorIndex = xlNone Next Range("L10").Formula = "=if(K10="""","""",if(K10=""Loss"",0,if(K10=""Void"",J10,J10*H10)))" Range("L11").Formula = "=if(K11="""","""",if(K11=""Loss"",0,if(K11=""Void"",J11,J11*H11)))" Range("L12").Formula = "=if(K12="""","""",if(K12=""Loss"",0,if(K12=""Void"",J12,J12*H12)))" Range("L13").Formula = "=if(K13="""","""",if(K13=""Loss"",0,if(K13=""Void"",J13,J13*H13)))" Range("L14").Formula = "=if(K14="""","""",if(K14=""Loss"",0,if(K14=""Void"",J14,J14*H14)))"
For t = 25 To 524 Step 2 Range("C" & t & ":L" & t).Interior.ColorIndex = 24 Range("C" & t + 1 & ":L" & t + 1).Interior.ColorIndex = xlNone Next Application.ScreenUpdating = True End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("E23:E523")) Is Nothing Then Range("E23:E523").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "N1"), Unique:=True If Not Intersect(Target, Range("F23:F523")) Is Nothing Then Range("F23:F523").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "O1"), Unique:=True If Not Intersect(Target, Range("I23:I523")) Is Nothing Then Range("I23:I523").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "P1"), Unique:=True End If End Sub
Hvorfor kan du ikke bruge den samme liste, i stedet for 3
Du har blandet dine funktioner , sådan skal de se ud
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("E23:E523")) Is Nothing Then Range("E23:E523").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "N1"), Unique:=True End If If Not Intersect(Target, Range("F23:F523")) Is Nothing Then Range("F23:F523").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "O1"), Unique:=True End If If Not Intersect(Target, Range("I23:I523")) Is Nothing Then Range("I23:I523").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "P1"), Unique:=True End If End Sub
Private Sub CommandButton1_Click() Application.ScreenUpdating = False For t = 10 To 14 x = Cells(524, 11).End(xlUp).Row + 1 If x < 25 Then x = 25 If Cells(t, 11) <> "" Then y = Range("C" & t & ":L" & t).Value Range("C" & x & ":L" & x) = y Cells(x, 3).Value = CDate(Cells(x, 3).Value) Range("C" & t & ":L" & t).ClearContents End If Next x = Cells(524, 11).End(xlUp).Row Range("C25:L" & x).Select Selection.Sort Key1:=Range("C25"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal
For t = 10 To 14 Step 2 Range("C" & t & ":L" & t).Interior.ColorIndex = 24 Range("C" & t + 1 & ":L" & t + 1).Interior.ColorIndex = xlNone Next Range("L10").Formula = "=if(K10="""","""",if(K10=""Loss"",0,if(K10=""Void"",J10,J10*H10)))" Range("L11").Formula = "=if(K11="""","""",if(K11=""Loss"",0,if(K11=""Void"",J11,J11*H11)))" Range("L12").Formula = "=if(K12="""","""",if(K12=""Loss"",0,if(K12=""Void"",J12,J12*H12)))" Range("L13").Formula = "=if(K13="""","""",if(K13=""Loss"",0,if(K13=""Void"",J13,J13*H13)))" Range("L14").Formula = "=if(K14="""","""",if(K14=""Loss"",0,if(K14=""Void"",J14,J14*H14)))"
For t = 25 To 524 Step 2 Range("C" & t & ":L" & t).Interior.ColorIndex = 24 Range("C" & t + 1 & ":L" & t + 1).Interior.ColorIndex = xlNone Next Application.ScreenUpdating = True End Sub
Næh, regnearket skal bruges til statistik over spil på internettet. I kolonne E indtastes hvilken sport man spiller på, kolonne F er spiltype og kolonne I er bookmaker. Så for hver spil indtastes data i en række, og listerne skal så bruges til at kunne sammenligne de enkelte sportsgrene, spiltyper og bookmakere... Men der står ikke noget der er anderledes i Kolonne I...
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.