Avatar billede cutehobbes Nybegynder
20. januar 2012 - 21:26 Der er 16 kommentarer og
1 løsning

Kopier hel række til andet ark hvis en given betingelse opfyldes

Hej,

jeg har et Excel regneark med 4 ark.
Ark 1 indeholder en hel masse data fra A-G
Ark 2 skal indeholde de rækker fra ark 1, der opfylder en betingelse i kolonne F
Ark 3 skal indeholde de rækker fra ark 2, der opfylder en betingelse fra kolonne G
Ark 4 skal indeholde resten

Dette for at få et hurtigt overblik - jeg har Filter på Ark 1 - men for dem der ønsker det skal der være hurtig adgang til de enkelte oplysninger :)

Kan man det uden Makro/VBA? Hvis ikke hvad gør jeg, har nul erfaring med Makro/VBA
Hvordan sikrer man at ark 2-4 altid opdateres når jeg tilføjer nyt til ark 1?
Avatar billede KurtOA Praktikant
20. januar 2012 - 23:55 #1
Hej Cutehobbes.

Jeg kan ikke umiddelbart se nogen mulighed for at gøre det uden kode - men her vil det kunne gøres ret enkelt, idet det kan skrives en kode der ved åbning af ark 2 og 3 vil kunne kopiere de ønskede rækker fra ark 1 således at disse 2 ark altid viser det ønskede. Prøv evt at beskrive nærmere hvad det er for kriterier du har der skal opfyldes på ark 1 - måske kan jeg eller anden hjælpe dig videre.

mvh Koa
Avatar billede kabbak Professor
20. januar 2012 - 23:57 #2
Så skal vi da vist have et demo ark, med data

hba snabela kabbak dot dk
Avatar billede cutehobbes Nybegynder
21. januar 2012 - 08:59 #3
Hej KurtOA, du må meget gerne prøve at lave en kode - jeg helt blank :)

Altså på Ark 1 står der brugernavn, mobilnr, simkortnr, imei nr, mobilt bredbånd og en bemærkning
På Ark 2 ønsker jeg de rækker fra ark 1, der har et x i mobilt bredbånd kolonnen
På Ark 3 ønsker jeg de rækker fra ark 1, der har et ? i bemærkning kolonnen
På Ark 4 ønsker jeg de rækker fra ark 1, der hverken har et ? el. x
(måske en overflødig ting, det har jeg ikke kunnet vurdere ;-D)

Er det nok info, eller skal du bruge et demo ark som kabbak nævner?
Avatar billede kabbak Professor
21. januar 2012 - 10:09 #4
Her er min løsning på problemet.
Bemærk at der ikke må være data i G kolonnen på ark 1

Alt herunder skal ind i et modul:

Option Explicit
Option Base 1


Public Sub Flyt()
'Altså på Ark 1 står der brugernavn, mobilnr, simkortnr, imei nr, mobilt bredbånd og en bemærkning
'På Ark 2 ønsker jeg de rækker fra ark 1, der har et x i mobilt bredbånd kolonnen
'På Ark 3 ønsker jeg de rækker fra ark 1, der har et ? i bemærkning kolonnen
'På Ark 4 ønsker jeg de rækker fra ark 1, der hverken har et ? el. x

    Dim RåData As Variant, UdData2 As Variant, UdData3 As Variant, UdData4 As Variant
    Dim UD2 As Long, UD3 As Long, UD4 As Long
    Dim I As Integer, J As Long, X As Integer, Kol As Integer, Rk As Long, Y As Integer
    UD2 = 2
    UD3 = 2
    UD4 = 2
    RåData = Worksheets("Ark1").Range("A1").CurrentRegion
    Rk = UBound(RåData, 1)
    Kol = UBound(RåData, 2)

    ReDim UdData2(Rk, Kol)
    ReDim UdData3(Rk, Kol)
    ReDim UdData4(Rk, Kol)

    For I = 1 To UBound(RåData, 2)
        UdData2(1, I) = RåData(1, I)
        UdData3(1, I) = RåData(1, I)
        UdData4(1, I) = RåData(1, I)
    Next

    For J = 2 To Rk
        Y = InStr(1, UCase(RåData(J, Kol)), "X")
        If InStr(1, UCase(RåData(J, Kol)), "X") > 0 Then
            For X = 1 To Kol
                UdData2(UD2, X) = RåData(J, X)
            Next
            UD2 = UD2 + 1

        ElseIf InStr(1, RåData(J, Kol), "?") > 0 Then
            For X = 1 To Kol
                UdData3(UD3, X) = RåData(J, X)
            Next
            UD3 = UD3 + 1

        Else
            For X = 1 To Kol
                UdData4(UD4, X) = RåData(J, X)
            Next
            UD4 = UD4 + 1
        End If

    Next
    Worksheets("Ark2").Range("A1").Resize(Rk, Kol) = UdData2
    Worksheets("Ark3").Range("A1").Resize(Rk, Kol) = UdData3
    Worksheets("Ark4").Range("A1").Resize(Rk, Kol) = UdData4
    Worksheets("Ark1").Range("A1").CurrentRegion.Clear

End Sub
Avatar billede kabbak Professor
21. januar 2012 - 10:10 #5
Sidste linje tømmer data i ark 1, slet den hvis du ikke ønsker det.

  Worksheets("Ark1").Range("A1").CurrentRegion.Clear
Avatar billede kabbak Professor
21. januar 2012 - 10:16 #6
Så lige at jeg brugte forkert kolonne, det er kolonne 5 = E kolonnen, den skulle tjekke.

Public Sub Flyt()
'Altså på Ark 1 står der brugernavn, mobilnr, simkortnr, imei nr, mobilt bredbånd og en bemærkning
'På Ark 2 ønsker jeg de rækker fra ark 1, der har et x i mobilt bredbånd kolonnen
'På Ark 3 ønsker jeg de rækker fra ark 1, der har et ? i bemærkning kolonnen
'På Ark 4 ønsker jeg de rækker fra ark 1, der hverken har et ? el. x

    Dim RåData As Variant, UdData2 As Variant, UdData3 As Variant, UdData4 As Variant
    Dim UD2 As Long, UD3 As Long, UD4 As Long
    Dim I As Integer, J As Long, X As Integer, Kol As Integer, Rk As Long, Y As Integer
    UD2 = 2
    UD3 = 2
    UD4 = 2
    RåData = Worksheets("Ark1").Range("A1").CurrentRegion
    Rk = UBound(RåData, 1)
    Kol = UBound(RåData, 2)

    ReDim UdData2(Rk, Kol)
    ReDim UdData3(Rk, Kol)
    ReDim UdData4(Rk, Kol)

    For I = 1 To UBound(RåData, 2)
        UdData2(1, I) = RåData(1, I)
        UdData3(1, I) = RåData(1, I)
        UdData4(1, I) = RåData(1, I)
    Next

    For J = 2 To Rk
        If InStr(1, UCase(RåData(J, 5)), "X") > 0 Then
            For X = 1 To Kol
                UdData2(UD2, X) = RåData(J, X)
            Next
            UD2 = UD2 + 1

        ElseIf InStr(1, RåData(J, 5), "?") > 0 Then
            For X = 1 To Kol
                UdData3(UD3, X) = RåData(J, X)
            Next
            UD3 = UD3 + 1

        Else
            For X = 1 To Kol
                UdData4(UD4, X) = RåData(J, X)
            Next
            UD4 = UD4 + 1
        End If

    Next
    Worksheets("Ark2").Range("A1").Resize(Rk, Kol) = UdData2
    Worksheets("Ark3").Range("A1").Resize(Rk, Kol) = UdData3
    Worksheets("Ark4").Range("A1").Resize(Rk, Kol) = UdData4
  '  Worksheets("Ark1").Range("A1").CurrentRegion.Clear

End Sub
Avatar billede cutehobbes Nybegynder
21. januar 2012 - 10:50 #7
Hold da op kabbak det er noget af en kode :)
Jeg kan slet ikke gennemskue det - og hvad gør jeg med den kode? :)

Går jeg ind og laver en makro? Jeg er total nybegynder med det her...
Avatar billede kabbak Professor
21. januar 2012 - 11:16 #8
OK, start dit regneark op,
når du så står på ark1, tryk så ALT+F11
Nu kommer VBA editoren frem,
Vælg Insert module,
Sæt min kode ind på den hvide flade.
luk på øverste X oppe i højre hjørne,
gem regnearket, NB hvis det er Excel 2007 eller 2010, så skal du gemme mappen, som en med makroer( det gør du i Gem som)

vælg kør makro,( husk det med makrosikkerhed), vælg flyt.

Hvis du vælger den sidste jeg skrev, der har jeg fravalgt at den skal tømme ark1,

så skulle det køre
Avatar billede cutehobbes Nybegynder
21. januar 2012 - 12:51 #9
Ok tak :)
Det prøver jeg lige .....
Avatar billede cutehobbes Nybegynder
21. januar 2012 - 12:59 #10
Ingen problem i at følge din anvisning :) Tak...

På ark 2 og ark 3 kommer der kun overskrifter
På ark 4 kommer det hele fra ark 1

Skal jeg rette noget i koden?
Avatar billede kabbak Professor
21. januar 2012 - 13:07 #11
Tjek lige at du har "mobilt bredbånd" til at stå i E1 kolonnen, det er kolonne 5.
Hvis ikke så ret 5 tallet, til det kolonnenummer du har, i de 2 linjer med

If InStr(1, UCase(RåData(J, 5)), "X") > 0 Then

ElseIf InStr(1, RåData(J, 5), "?") > 0 Then
Avatar billede cutehobbes Nybegynder
21. januar 2012 - 13:21 #12
Er det ok jeg sender dig et demo ark?
Jeg har lidt svært ved at gennemskue det kode - når det er første gang jeg ser sådan noget :)

Måske jeg bagefter kan kigge det igennem og forstå det lidt bedre :)
Avatar billede kabbak Professor
21. januar 2012 - 13:56 #13
det er ok
Avatar billede kabbak Professor
21. januar 2012 - 14:10 #14
hba snabela kabbak dot dk
Avatar billede cutehobbes Nybegynder
21. januar 2012 - 14:49 #15
mail på vej til dig :)
Avatar billede kabbak Professor
21. januar 2012 - 15:44 #16
færdig kode ser sådan ud:

Option Explicit
Option Base 1
Public Sub Flyt()
'Altså på Ark 1 står der brugernavn, mobilnr, simkortnr, imei nr, mobilt bredbånd og en bemærkning
'På Ark 2 ønsker jeg de rækker fra ark 1, der har et x i mobilt bredbånd kolonnen
'På Ark 3 ønsker jeg de rækker fra ark 1, der har et ? i bemærkning kolonnen
'På Ark 4 ønsker jeg de rækker fra ark 1, der hverken har et ? el. x

    Dim RåData As Variant, UdData2 As Variant, UdData3 As Variant, UdData4 As Variant
    Dim UD2 As Long, UD3 As Long, UD4 As Long
    Dim I As Integer, J As Long, X As Integer, Kol As Integer, Rk As Long, Y As Integer
    UD2 = 2
    UD3 = 2
    UD4 = 2
    RåData = Sheets(1).Range("A1").CurrentRegion
    Rk = UBound(RåData, 1)
    Kol = UBound(RåData, 2)

    ReDim UdData2(Rk, Kol)
    ReDim UdData3(Rk, Kol)
    ReDim UdData4(Rk, Kol)

    For I = 1 To UBound(RåData, 2)
        UdData2(1, I) = RåData(1, I)
        UdData3(1, I) = RåData(1, I)
        UdData4(1, I) = RåData(1, I)
    Next

    For J = 2 To Rk
        If InStr(1, UCase(RåData(J, 6)), "X") > 0 Then
            For X = 1 To Kol
                UdData2(UD2, X) = RåData(J, X)
            Next
            UD2 = UD2 + 1

        ElseIf InStr(1, RåData(J, 7), "?") > 0 Then
            For X = 1 To Kol
                UdData3(UD3, X) = RåData(J, X)
            Next
            UD3 = UD3 + 1

        Else
            For X = 1 To Kol
                UdData4(UD4, X) = RåData(J, X)
            Next
            UD4 = UD4 + 1
        End If

    Next
    Sheets(2).Range("A1").Resize(Rk, Kol) = UdData2
  Sheets(3).Range("A1").Resize(Rk, Kol) = UdData3
  Sheets(4).Range("A1").Resize(Rk, Kol) = UdData4
  '  Worksheets("Ark1").Range("A1").CurrentRegion.Clear

End Sub
Avatar billede cutehobbes Nybegynder
21. januar 2012 - 16:08 #17
KANON :-) Tak for det... og tak for tålmodigheden.
Næste skridt er så at forstå det ;-)
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

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