Just nu i M3-nätverket
Gå till innehåll

Hitta matcha kopiera klistra in på nyskapad blankrad


jnnordling

Rekommendera Poster

Tjenis!

 

Jag är väldigt ny inom VBA och har stött på ett problem och skulle väldigt gärna behöva lite hjälp.

 

I en workbook har jag två sheets. På sheet1 har jag massor med data som jag själv lägger in från ett system manuellt. På "Sheet2" har jag två kolumner där talen i kolumn B matchar med talen i kolumn BA "Sheet1".

 

Det jag vill göra att makrot ska göra är:

Starta på rad2 i Sheet1, där ska den kolla numret som finns i Kolumn BA. Därefter ska den hitta samma värde fast på kolumn B i Sheet2. När den hittat det värde ska den skapa en blankrad raden under det funna värdet i Sheet2. Sedan ska hela raden från Sheet1 kopieras och klistras in på den tomma raden i Sheet2. Sedan ska den fortsätta så hela vägen tills det inte finns några rader med data kvar i Sheet1. OBS att samma nummer kan förekomma flertalet gånger i Sheet1 kolumn BA men det står bara en gång vardera i Sheet2 kolumn B. Sheet2 fungerar för att organisera så därför om det finns flertalet av samma tal i Sheet1 som matcher så lägger dem sig bara under varandra.  

 

Jag vill också att man ska kunna uppdatera Sheet1 genom att lägga till ny data där (i samma struktur som innan då). Om jag då trycker på makro-knappen igen vill jag inte att den ska kopiera in dem raderna som den redan kopierat för då kommer jag få massa dubbeldata och det är inte bra sedan när man ska göra pivot-tabeller, diagram osv....

 

Jag är som sagt inte så bra på VBA och har letat mycket på internet och skrapat ihop den här koden, problemet är bara att den kopierar den rad2 från Sheet1 in till rad2 på Sheet2 men sen hoppar den längst ner till sista raden i Sheet1 som är tom och klistrar in tomma rader under varje tal i Sheet2 istället..

 

Function DoOne(RowIndex As Integer) As Boolean

    Dim FG

    Dim Target

    Dim Success

    Success = False

    If Not IsEmpty(Cells(RowIndex, 2).Value) Then

        FG = Cells(RowIndex, 53).Value

 

        Sheets("Sheet1").Select

 

        Set Target = Columns(53).Find(FG, LookIn:=xlValues)

 

        If Not Target Is Nothing Then

            Rows(Target.Row).Select

            Selection.Copy

            Sheets("Sheet2").Select

            Rows(RowIndex + 1).Select

            Selection.Insert Shift:=xlDown

            Rows(RowIndex + 2).Select

            Application.CutCopyMode = False

            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

            Cells(RowIndex + 3, 2).Select

            Success = True

        End If

 

    End If

    DoOne = Success

End Function

 

Sub TheMacro()

    Dim RowIndex As Integer

    Sheets("Sheet2").Select

    RowIndex = Cells.Row

    While DoOne(RowIndex)

        RowIndex = RowIndex + 3

    Wend

End Sub

 

Är tacksam för all hjälp!

Länk till kommentar
Dela på andra webbplatser

med andra ord.

På blad 2 har du index i kolumn A

 

På blad 1 kan samma index förekomma flera gånger, även där i kolumn A.

Om träff ska rad infogas på blad2 och funnen rad på blad1 kopieras in.

Alla träffas ska kopieras/infogas.

 

Docka ska inte samma rad kopieras flera gånger om makrot körs igen.

Då måste du på något sätt antingen markera raden på blad1 eller hitta något unikt med varje rad. Jag anar att en rad på blad1 inte säkert ligger kvar på samma rad på blad1?

 

Du kan inte klippa ut raden på blad1

 

Alltså, egentligen, varför gå via VBA alls?

Varför inte lägga till en kolumn på blad1 där du manuellt eller via formel sätter en etikett på varje rad. Därefter sammanfattar du dina data med just en Pivotabell. Ingen VBA-kod behövs.

 

Om du vill ha VBA-kod, ge mig en exempelbok.

Länk till kommentar
Dela på andra webbplatser

med andra ord.

På blad 2 har du index i kolumn A

 

På blad 1 kan samma index förekomma flera gånger, även där i kolumn A.

Om träff ska rad infogas på blad2 och funnen rad på blad1 kopieras in.

Alla träffas ska kopieras/infogas.

 

Docka ska inte samma rad kopieras flera gånger om makrot körs igen.

Då måste du på något sätt antingen markera raden på blad1 eller hitta något unikt med varje rad. Jag anar att en rad på blad1 inte säkert ligger kvar på samma rad på blad1?

 

Du kan inte klippa ut raden på blad1

 

Alltså, egentligen, varför gå via VBA alls?

Varför inte lägga till en kolumn på blad1 där du manuellt eller via formel sätter en etikett på varje rad. Därefter sammanfattar du dina data med just en Pivotabell. Ingen VBA-kod behövs.

 

Om du vill ha VBA-kod, ge mig en exempelbok.

Hej Monshi!

 

Ber om ursäkt ifall jag va lite rörig...

Meningen är att man ska kunna strukturera upp den data man har på ett bra sätt och automatisera sen när man lägger in ny data, Jag chansar på att man kanske kan starta makrot från en valfri cell och isåfall löser man problemet med att få samma fakta flera gånger.

 

Det som jag vill med makrot är att den ska hitta rätt funktionsgrupp, alltså de tal som finns på sida 2 kolumn B är alla de funktionsgrupper som man kan ha möjliga uppgifter om. På sida 1 finns alla uppgifter till de olika funktionsgrupperna. På en rad står det massa fakta om enskilt fall men fallen ska sorteras under funktionsgrupperna för att man lätt ska kunna hitta de olika data och så som behövs. På Kolumn BA i sida 1 står då vilken funktionsgrupp som uppgifterna är till och därför tänkte jag att man kunde matcha så att det lätt kunde sorteras. 

 

Jag är väldigt öppen för andra förslag som är lättare för jag är lite av en nybörjare när det kommer till sådant här.

 

Jag hittade inte hur man lägger in excel här (känner mig rätt dum nu ja) skulle du bara förklara hur så får du en exempelbok.

Tack för att du tar dig tid!

Länk till kommentar
Dela på andra webbplatser

Bara för att poängtera, VBA är inte nödvändigt om det är pivot du vill åt. Om du inte ska göra mer beräkningar på materialet på blad2 innan du applicerar pivot.

 

men okej, koden.

Vi inför en cell där koden sparar var den var senast samt val att köra koden från valfri cell. Samt jag städar upp din kod lite.

Inte helt säker på vad din kod gör... men ändringarna borde göra det du vill.

Function DoOne(RowIndex As Integer, searchRange) As Boolean
    Dim FG
    Dim Target
    Dim Success
    Success = False
    With Sheet2
    If Not IsEmpty(.Cells(RowIndex, 2).Value) Then
        FG = Cells(RowIndex, 53).Value
        Set Target = Sheet1.Columns(53).Find(FG, LookIn:=xlValues)
        If Not Target Is Nothing Then
            Sheet1.Rows(Target.Row).Copy
            
            
            .Rows(RowIndex + 1).Insert Shift:=xlDown
            .Rows(RowIndex + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Application.CutCopyMode = False
            
            'Cells(RowIndex + 3, 2).Select
            Success = True
        End If
    End If
    DoOne = Success
End Function

 

Sub TheMacro()
    Dim RowIndex As Integer
    
    With Sheet2
        RowIndex = .Cells.Row
    End With
    
    Sheet1.Activate
    Dim rw As Integer
    Dim myRn As Range
    rw = Sheet2.Range("lastCell").Value
    If rw = 0 Then rw = 1
    On Error Resume Next
    Blad1.Cells(rw, 1).Select
    Set myRn = Application.InputBox("Ange startcell för sökning", "Sökning", Default:=Sheet1.Cells(rw, 1).Address, Type:=8)
    On Error GoTo 0
    If myRn Is Nothing Then Exit Sub
    Set myRn = myRn.Resize(myRn.CurrentRegion.Rows.CountLarge - myRn.Row + 1)
    While DoOne(RowIndex, myRn)
        RowIndex = RowIndex + 3
    Wend
    Sheet2.Range("lastCell") = Sheet1.Cells(1, 1).CurrentRegion.Rows.Count
End Sub

Namnge en cell på blad1 till lastCell. Där sparar makrot antal rader vid senaste operation och hjälper vid val.

 

Och bort bort med alla icke nödvändiga select-satser.

Länk till kommentar
Dela på andra webbplatser

Tack så mycket för hjälpen, jag tror att jag måste ha namngett cellen fel dock för den vill inte köra...

 

skulle du vilja förklara hur man namnger också så hade det varit väldigt snällt, annars så tackar jag verkligen väldigt mycket för att du tagit dig tid till att hjälpa mig!

Länk till kommentar
Dela på andra webbplatser

Enklaste sättet att namnge en cell är att markera cellen i fråga och skriva in namnet i namnrutan uppe till vänster i Excels fönster. Du kan ersätta namnet med en exakt referens om du vill, dvs Sheet1.Range("F1") exempelvis.

Länk till kommentar
Dela på andra webbplatser

Fungerar det?

 

Om inte, skapa en exempelbok, zippa om kod i den och använd fullständig editor när du svarar. Då kan du bifoga din arbetsbok/zip-arkiv.

Länk till kommentar
Dela på andra webbplatser

jnnordling

nej det vill inte riktigt fungera, jag har namngett en cell men det blir ändå error... jag testade med att byta ut lastcell på en riktigt cell med och då kör den igång men det matchar inte funktionsgupperna med varandra utan klistrar in under så som den ska förutom att det skapas en blankrad för mycket. Det blir då inte rätt ordning. Om jag har fattat rätt nu så ligger koden i arbetsboken och är aktiverad till knappen.

 

Ber om ursäkt för sent svar

Exempelbok.zip

Länk till kommentar
Dela på andra webbplatser

Mycket enklare med ett exempel.

 

Lastcell, en ledig cell dit koden kan skriva och spara ett värde. Jag lade den på ett helt eget blad nu. Via den cellen "minns" boken hur många rader det senast var på blad1 när koden kördes.

Har byggt om, och bytt namn på DoOne. Nu söker den efter alla träffar inom givet sökområde och kopierar in alla träffar.

 

Moderrutinen, Button1_Click, har jag ändrat till en For sats som stegar från sista rad och uppåt på blad2. Detta eftersom det stoppas in nya rader under den post som det söks efter. Då tappar man aldrig bort något.

 

ta en titt på koden, försök förstå vad den gör. Fråga om det är något.

Exempelbok.zip

Länk till kommentar
Dela på andra webbplatser

jnnordling

När jag testar att köra så står det "Object required". Den vill alltså inte komma iväg trots att jag väljer den cell med den funktionsgrupp som ligger högst upp på Sheet1, gör jag något fel när jag ska starta den?

Länk till kommentar
Dela på andra webbplatser

oops, slarv av mig. raden du får stopp på  (gul i VBA-editorn, ändra Target till c.

Länk till kommentar
Dela på andra webbplatser

jnnordling

Nu funkar det helt perfekt!

 

Tusen tack verkligen för att du tog dig tid att hjälpa mig! Ska sitta och försöka lära mig VBA bättre så att jag själv kan lösa nästa problem som uppstår i framtiden.

 

Återigen tacktack!!

Länk till kommentar
Dela på andra webbplatser

Arkiverat

Det här ämnet är nu arkiverat och är stängt för ytterligare svar.



×
×
  • Skapa nytt...