05. november 2010 - 10:02Der er
5 kommentarer og 1 løsning
VBA funktion i excel ...
Hej
"Excelent" har lavet denne formel i et tidl. indlæg:
Værdier i A som ikke findes i B markeres med gul Værdier i B som ikke findes i A markeres med grøn
Husk at rette fra/til i koden
Sub Sammenlign() fra = 1: til = 18 ' Ret fra/til til aktuel første/sidste række
For Each c In Range("A" & fra & ":A" & til) If Application.CountIf(Range("B" & fra & ":B" & til), c) Then c.Interior.ColorIndex = xlNone Else c.Interior.ColorIndex = 6 End If Next For Each c In Range("B" & fra & ":B" & til) If Application.CountIf(Range("A" & fra & ":A" & til), c) Then c.Interior.ColorIndex = xlNone Else c.Interior.ColorIndex = 4 End If Next End Sub
Men jeg har brug for en ekstra funktion til denne formel/makro kan denne makro udvides så den kopiere dem som er markeret med som i eks. gul til en ny kolonne og samme med dem som er blevet markeret med grøn farve til en given kollonne eller nyt underark.
har forsøgt mig lidt frem men VBA er total sort for mig.
Sub Sammenlign() Dim fra, til, c, i fra = 1: til = 5 ' Ret fra/til til aktuel første/sidste række i = 1
For Each c In Range("A" & fra & ":A" & til) If Application.CountIf(Range("B" & fra & ":B" & til), c) Then c.Interior.ColorIndex = xlNone Else c.Interior.ColorIndex = 6 Range("C" & i).Value = c.Value i = i + 1 End If Next For Each c In Range("B" & fra & ":B" & til) If Application.CountIf(Range("A" & fra & ":A" & til), c) Then c.Interior.ColorIndex = xlNone Else c.Interior.ColorIndex = 4 Range("C" & i).Value = c.Value i = i + 1 End If Next End Sub
Sub Sammenlign() Dim fra, til, c, i fra = 1: til = 5 ' Ret fra/til til aktuel første/sidste række i = 1
For Each c In Range("A" & fra & ":A" & til) If Application.CountIf(Range("B" & fra & ":B" & til), c) Then c.Interior.ColorIndex = xlNone Else c.Interior.ColorIndex = 6 Range("C" & i).Interior.ColorIndex = 6 Range("C" & i).Value = c.Value i = i + 1 c.Delete xlUp End If Next For Each c In Range("B" & fra & ":B" & til) If Application.CountIf(Range("A" & fra & ":A" & til), c) Then c.Interior.ColorIndex = xlNone Else c.Interior.ColorIndex = 4 Range("C" & i).Interior.ColorIndex = 4 Range("C" & i).Value = c.Value i = i + 1 c.Delete xlUp End If Next End Sub
den efterlader stadig nogle af de markerede værdier og flytter godt nok nogle af dem men ikke alle.. 16 flytter den ud af 23 værdiger i A kollonnen: B kollonnen virker der flytter den 4 ud af 4.
Ah ja, der kommer jo kludder i index når man sletter i en for-each.. Hvad med denne?:
Sub Sammenlign() Dim fra, til, c, i fra = 1: til = 8 ' Ret fra/til til aktuel første/sidste række i = 1
For Each c In Range("A" & fra & ":A" & til) If Application.CountIf(Range("B" & fra & ":B" & til), c) Then c.Interior.ColorIndex = xlNone Else c.Interior.ColorIndex = 6 Range("C" & i).Interior.ColorIndex = 6 Range("C" & i).Value = c.Value i = i + 1 End If Next For Each c In Range("B" & fra & ":B" & til) If Application.CountIf(Range("A" & fra & ":A" & til), c) Then c.Interior.ColorIndex = xlNone Else c.Interior.ColorIndex = 4 Range("C" & i).Interior.ColorIndex = 4 Range("C" & i).Value = c.Value i = i + 1 End If Next
For i = 1 To til Set c = Range("A" & i) If c.Interior.ColorIndex = 6 Then c.Delete xlUp i = i - 1 End If Next For i = 1 To til Set c = Range("B" & i) If c.Interior.ColorIndex = 4 Then c.Delete xlUp i = i - 1 End If Next
kan være jeg stiller et nyt udvidet spm senere når den skal være mere avanceret !
Synes godt om
Ny brugerNybegynder
Din løsning...
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.
