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

Makro för att loopa igenom celler och kopiera innehåll

Rekommendera Poster

Hej.

 

Har suttit i evigheter för att försöka lösa mitt problem men har fastnat helt och vet inte ens längre var jag ska börja…

 

Jag ska göra ett bemanningsschema och har underlaget i kolumnerna A-F på bladet ”Fakta”. Jag vill skapa ett makro som loopar igenom C2:G6, rad för rad, och utifrån respektive cells värde kopiera information till bladet ”Schema” det antal gånger som värdet i cellen anger, dvs. 4 ggr enligt C2, 3 ggr enligt D2 osv. Informationen ska kopieras enligt följande:

A10 till Kolumn A

A2, A3, A4 osv. till Kolumn B

B2, B3, B4 osv. till Kolumn C

C1, D1, E1 osv. till Kolumn D

 

Resultatet ska se ut som i bifogat exempel.

 

Någon som kan hjälpa mig?

Underlag.JPG

Resultat.JPG

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser
Postad (redigerade)
Sub SkapaSchema()
    Dim dataRad%, dataKol%, printRad%, ant%
    With Sheets(1)
        dataRad = 2
        printRad = 2
        ' Alla rader fram till tom cell
        Do Until IsEmpty(.Cells(dataRad, 1))
            dataKol = 3 ' Hämta antal i kolumn C
            ' Alla kolumner fram till tom cell
            Do Until IsEmpty(.Cells(dataRad, dataKol))
                For ant = 1 To .Cells(dataRad, dataKol)
                    Sheets(2).Cells(printRad, 1) = .Cells(10, 1)        ' Datum
                    Sheets(2).Cells(printRad, 2) = .Cells(dataRad, 1)   ' Intervall
                    Sheets(2).Cells(printRad, 3) = .Cells(dataRad, 2)   ' Min
                    Sheets(2).Cells(printRad, 4) = .Cells(1, dataKol)   ' Enhet
                    printRad = printRad + 1
                Next
                dataKol = dataKol + 1
            Loop
            dataRad = dataRad + 1
        Loop
    End With
    ' Rensa i slutet
    Do Until IsEmpty(Sheets(2).Cells(printRad, 1))
        Sheets(2).Cells(printRad, 1) = Null
        Sheets(2).Cells(printRad, 2) = Null
        Sheets(2).Cells(printRad, 3) = Null
        Sheets(2).Cells(printRad, 4) = Null
        printRad = printRad + 1
    Loop
End Sub

 

Redigerad av MickeF
Fel i koden rättat!

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Här har du en fuling som jag påbörjade tidigare idag. Orkar inte snygga till den eftersom Micke har postat en betydligt elegantare och flexiblare lösning. Men det kan ju vara lättare att förstå om du får se två varianter eftersom vi tänkt ungefär likadant. Dessutom kan du kolla om du får samma resultat  (om du tar bort -3 på rad 11).

 

Lustigt att Ingen av oss tänkte på att summera C2:G6 för att hitta ett säkerhets - exit-värde för målrad/printrad. Ja, ja

 

Sub loooper()
Dim rStartKällCell As Range
Dim iRad As Integer
Dim iMålRad As Integer
Dim iKolNr As Integer
Dim i As Integer
iMålRad = 2
Set rStartKällCell = Worksheets("Fakta").[b1]

For iRad = 1 To 5
    For iKolNr = 1 To 5
        For i = 1 To rStartKällCell.Offset(iRad, iKolNr).Value
            Worksheets("Schema").Cells(iMålRad, 1).Value = _
                Worksheets("Fakta").[a10].Value
            Worksheets("Schema").Cells(iMålRad, 2).Value = _
                Worksheets("Fakta").[A1].Offset(iRad, 0)
            Worksheets("Schema").Cells(iMålRad, 3).Value = _
                Worksheets("Fakta").[b1].Offset(iRad, 0)
            Worksheets("Schema").Cells(iMålRad, 4).Value = _
                Worksheets("Fakta").[b1].Offset(, iKolNr)
            iMålRad = iMålRad + 1
       Next i
    
    Next iKolNr
Next iRad
End Sub

 

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser
1 timme sedan, MH_resurrected säger:

Dessutom kan du kolla om du får samma resultat  (om du tar bort -3 på rad 11).

 

Tack den där debug-biten glömde jag ta bort :D
Nu är det redigerat.

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Tack! Har nu testat era lösningar och båda fungerar flawless! Grymt tacksam för er hjälp :)

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Skapa ett konto eller logga in för att kommentera

Du måste vara medlem för att kunna kommentera

Skapa ett konto

Skapa ett nytt konto på vårt forum. Det är lätt!

Registrera ett nytt konto

Logga in

Redan medlem? Logga in här.

Logga in nu



×
×
  • Skapa nytt...