24. marts 2014 - 20:02Der er
7 kommentarer og 1 løsning
Flyt kun værdier, når en hel række flyttes fra ark1 til ark 2 ved ændringer i en eller flere celler
Hej
Dette er et opfølgende spørgsmål til et tidligere spørgsmål der lød "flyt række fra ark1 til ark 2 ved ændringer i en eller flere celler"
Jeg fik en glimrende løsning til problemet med kode 1 - se nedenstående. Et problem, som dukkede op umiddelbart efter, var dog at koden også flyttede formler med, hvilket resulterede i fejl i de respektive celler på ark2. Jeg har forsøgt at løse problemet ved at indsætte dataene som værdier i ark2, hvilket også lykkes - se kode 2
Problemet, som jeg vil frem til er, at flytningen med kode 1 stort set ikke bliver opdaget af brugerne af arket, mens flytningen er meget tydelig i kode 2, når arket opdateres.
Det er nok kun et kosmetisk problem:-), men er det muligt at lave kode 2, sådan at flytningen i kode 2 går lige så ubemærket hen, som i kode 1
Kode 1
Private Sub Worksheet_Change(ByVal Target As Range) Dim RW As Long If Not Intersect(Target, Range("A:AV")) Is Nothing Then If Target.Row = ActiveCell.Row Then Target.Interior.Color = vbGreen ' laver rettet celle grøn Exit Sub ' NY End If Target.Interior.Color = vbGreen ' laver sidste rettede celle grøn, indrn kopiering RW = Worksheets("ark2").UsedRange.Rows.Count + 1 'row Target.EntireRow.Copy Worksheets("ark2").Range("A" & RW) Worksheets("ark2").Range("AW" & RW) = Now() ' sætter dato og klokken i kolonne AW Range(Cells(Target.Row, "A"), Cells(Target.Row, "AV")).Interior.ColorIndex = xlNone End If End Sub
Kode 2
Private Sub Worksheet_Change(ByVal Target As Range) Dim RW As Long If Not Intersect(Target, Range("A:AV")) Is Nothing Then If Target.Row = ActiveCell.Row Then Target.Interior.Color = vbGreen ' laver rettet celle grøn Exit Sub ' NY End If
Target.Interior.Color = vbGreen ' laver sidste rettede celle grøn, indrn kopiering
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
Private Sub Worksheet_Change(ByVal Target As Range) Dim RW As Long If Not Intersect(Target, Range("A:AV")) Is Nothing Then If Target.Row = ActiveCell.Row Then Target.Interior.Color = vbGreen ' laver rettet celle grøn Exit Sub ' NY End If
Target.Interior.Color = vbGreen ' laver sidste rettede celle grøn, indrn kopiering
Worksheets("ark2").Range("AW" & RW) = Now() ' sætter dato og klokken i kolonne AW Range(Cells(Target.Row, "A"), Cells(Target.Row, "AV")).Interior.ColorIndex = xlNone Application.CutCopyMode = False Application.ScreenUpdating = True End If End Sub
Et enkelt tillægsspørgsmål, så skal jeg nok stoppe:-)
Koden overfører fint værdier og formater til ark2, men cellefarverne på ark 1 forsvinder i "overførslen". Kan man få kode til at bibeholde farverne og evt. andre celleformater på ark 1?
Private Sub Worksheet_Change(ByVal Target As Range) Dim RW As Long If Not Intersect(Target, Range("A:AV")) Is Nothing Then If Target.Row = ActiveCell.Row Then Target.Interior.Color = vbGreen ' laver rettet celle grøn Exit Sub ' NY End If
Target.Interior.Color = vbGreen ' laver sidste rettede celle grøn, indrn kopiering
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.