Avatar billede hajhaj Nybegynder
09. juli 2009 - 15:31 Der er 5 kommentarer

Macro - check om værdi i område er forskellig fra anden værdi i samme område

Hej,

Er ved at lave en macro i Excel som skal chekke et range og hver gang værdi i cellerne skifter udføre en kopering af denne værdi til et andet ark. Men kun een gang for hver værdi.

F.eks. indeholder området (A1:A6) flg værdier:

22
22
3
24
26
26

Hver gang indholdet skifter skal der oprettes et nyt ark med navnet fra A1:A6 (f.eks. 26), og hvor området ud for (f.eks. A5: C6) disse kopieres i det tilhørende ark. I eksemplet oprettes 4 ark med navnene "22","3","24" og "26"

Kan nogen hjælpe mig med lidt excel macro kode?

mvh haj
Avatar billede lerskov Praktikant
09. juli 2009 - 21:31 #1
Nogen i denne stil du efterlyser?


Public Sub nyarkflyt()

Dim data As Variant
Dim ark() As Variant

r = Sheets("ark1").Range("a65000").End(xlUp).Row        'finder nedeste række i ark1

data = Sheets("ark1").Range("a1:c" & r)                ' indlæser data a1 til c ? som matrix

For t = LBound(data) To UBound(data)
      a = Sheets.Count
                Sheets(1).Select
                    For b = 1 To a
                        If CStr(data(t, 1)) = CStr(ActiveSheet.Name) Then      ' ser om ark findes i forvejen
                        findes = True
                        Exit For
                        End If
                        If b <> a Then
                        Sheets(b + 1).Select
                        Else
                        Sheets.Add.Name = data(t, 1)
                        End If
                    Next b
        Sheets(data(t, 1)).Select
        Range("a65000").End(xlUp).Activate
        With ActiveCell                                'indsætter data fra matrix i nyt ark.
        If ActiveCell <> "" Then
        .Offset(1, 0) = data(t, 1)
        .Offset(1, 1) = data(t, 2)
        .Offset(1, 2) = data(t, 3)
        Else
        ActiveCell = data(t, 1)
        .Offset(0, 1) = data(t, 2)
        .Offset(0, 2) = data(t, 3)
        End If
        End With
         
Next t

End Sub
Avatar billede hajhaj Nybegynder
10. juli 2009 - 15:30 #2
giver et 
Run-time error ')':
"subscript of range"

og stopper ved linien

        Sheets(data(t, 1)).Select
Avatar billede lerskov Praktikant
10. juli 2009 - 20:58 #3
Det lyder underligt, kan jeg ikke fremtvinge fejlen. Kan du evt. sende en fil til anders.lerskov (a) gmail dot com
Avatar billede hajhaj Nybegynder
12. juli 2009 - 17:43 #4
kan ikke helt få ovenstående til at virke. Men kan det ændres til:

For hver værdi i kolonne A - skal hele det aktive ark kopieres og navngives med "uge" + nr (fra kolonne A).
I det nye ark skal alle rækker i kolonne A, som ikke indeholder det aktuelle uge nr. slettes.
Dette skal gentages for hver unikke forekomst af et ugenr i kolonne A.

F.eks. indeholder området (A2:C7) flg værdier:

Uge  Størrelse Antal
22      XL      2
22      SM      2
3        L      45
24      M      2
26      L      11
26      M      8

Så der skal oprettes 4 ark med navnene "Uge 22", "Uge 3" osv
og i fx. arket "Uge 26" skal række 2 til 5 slettes så der står:

Uge  Størrelse Antal
26      L      11
26      M      8

kan du klare den
Avatar billede hajhaj Nybegynder
13. juli 2009 - 12:26 #5
Har selv fundet løsningen på

http://www.eksperten.dk/spm/47724

;-))
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester