Just nu i M3-nätverket
Jump to content

Hjälp med sammanställning av lista i Excel


mr Nobody
 Share

Recommended Posts

Hej.

 

Jag håller på med att försöka få iordning en arbetsbok i Excel där man ska kunna lägga in praktikloggar (bilden märkt "Mall") för varje vecka på en medarbetare för att sen ha ett huvudblad (bilden märkt "Sammanställning") där allt sammanställs.

Vad jag har läst mig till här på forumet så är det lättast att göra detta i VBA. Dock har jag knappt hållit på med VBA själv så ni får ha lite överinseende med hur koden ser ut, det går säkert att städa upp 

och snygga till den samt göra den mer effektiv om man har större kunskaper en vad jag har.

Jag hittade en kod i forumet i VBA som jag har lyckats anpassa så att jag just nu får en rad från varje praktiklogg att sammanställas på huvudbladet. Problemet är att det är ju flera rader på varje

praktiklogg och antalet rader skiljer sig också åt för varje praktiklogg. Det jag skulle behöva hjälp med är att få programmet att få med de andra raderna också.

 

Vad jag tror att man behöver så är det en till variabel som agerar räkneverk för antalet rader som är på första bladet som räknar ner hur många gånger man behöver repetera innan man går vidare till

nästa blad och i samma veva som man går över till nästa blad så ställs räkneverket om till hur många rader det finns på nästa blad och så vidare.

Området som man kan fylla i på praktikloggen kommer att vara konstant då dem bladen kommer att vara delvis låsta för redigering. I det här fallet vid sammanställningen så gäller det område B8:K45.

 

Hur koden ser ut så står den lite längre ner. 

 

Sub Sammanställning_objekt()

 

Dim i As Integer

Dim j As Integer

Dim iStartblad As Integer

Dim rDatum As Range

Dim rSMPnr As Range

Dim rObjektslag As Range

Dim rBesiktningstyp1 As Range

Dim rBesiktningstyp2 As Range

Dim rBesiktningstyp3 As Range

Dim rObserverat As Range

Dim rMedverkat As Range

Dim rSjälvständigt As Range

Dim rAvrapporterat As Range

 

'var skall listan landa (startpunkter)

 

Set rDatum = ActiveWorkbook.Worksheets("Sammanställning").Range("A8")

Set rSMPnr = ActiveWorkbook.Worksheets("Sammanställning").Range("B8")

Set rObjektslag = ActiveWorkbook.Worksheets("Sammanställning").Range("C8")

Set rBesiktningstyp1 = ActiveWorkbook.Worksheets("Sammanställning").Range("D8")

Set rBesiktningstyp2 = ActiveWorkbook.Worksheets("Sammanställning").Range("E8")

Set rBesiktningstyp3 = ActiveWorkbook.Worksheets("Sammanställning").Range("F8")

Set rObserverat = ActiveWorkbook.Worksheets("Sammanställning").Range("G8")

Set rMedverkat = ActiveWorkbook.Worksheets("Sammanställning").Range("H8")

Set rSjälvständigt = ActiveWorkbook.Worksheets("Sammanställning").Range("I8")

Set rAvrapporterat = ActiveWorkbook.Worksheets("Sammanställning").Range("J8")

 

'ange vilket som är det första databladet (nr i ordningen)

iStartblad = 4

 

j = 1

  

For i = iStartblad To ActiveWorkbook.Worksheets.Count

rDatum.Offset(j, 0).Value = ActiveWorkbook.Worksheets(i).Range("B8").Value

rSMPnr.Offset(j, 0).Value = ActiveWorkbook.Worksheets(i).Range("C8").Value

rObjektslag.Offset(j, 0).Value = ActiveWorkbook.Worksheets(i).Range("D8").Value

rBesiktningstyp1.Offset(j, 0).Value = ActiveWorkbook.Worksheets(i).Range("E8").Value

rBesiktningstyp2.Offset(j, 0).Value = ActiveWorkbook.Worksheets(i).Range("F8").Value

rBesiktningstyp3.Offset(j, 0).Value = ActiveWorkbook.Worksheets(i).Range("G8").Value

rObserverat.Offset(j, 0).Value = ActiveWorkbook.Worksheets(i).Range("H8").Value

rMedverkat.Offset(j, 0).Value = ActiveWorkbook.Worksheets(i).Range("I8").Value

rSjälvständigt.Offset(j, 0).Value = ActiveWorkbook.Worksheets(i).Range("J8").Value

rAvrapporterat.Offset(j, 0).Value = ActiveWorkbook.Worksheets(i).Range("K8").Value

j = j + 1

Next

End Sub

 

 

Sen en annan sak, jag ska även ha ett blad där alla kommentarerna sammanställs (se bild märkt "Kommentarer"). Grundkoden kan jag använda den jag redan har och bara anpassa den då det bara är en cell från varje blad som skall hämtas. Vad jag mer skulle vilja är att man automatiskt fyller i från vilket blad kommentaren kommer ifrån i A-kolumnen medans i B-kolumnen så kommer själva kommentaren.

Sen skulle jag också vilja att i cellen med kommentarerna så skall texten vara Radbruten och att radhöjden justeras automatiskt efter hur mycket text det är i kommentaren så att man kan läsa allt som står i varje cell.

Problemet med den automatiska radhöjdsanpassningen så består cellen i B-kolumnen av sammansatta celler och vad jag har förstått så har Excel problem med det.

Vad jag har lyckats läsa mig till så går det att ordna detta med hjälp av lite VBA-kod men har tyvärr inte lyckats med detta själv.

I exemplet nedan har jag använt mig av formler direkt i bladet och sen justerat radhöjden manuellt men det ser inte så snyggt ut som det är just nu och det är lite jobb med att få det någorlunda bra. Vill helst att detta skall ske automatiskt då det kommer vara andra som kommer att använda dessa blad också. 

 

Hoppas jag kan få lite hjälp med detta för mig stora problem. 

 

 

Mall (1).jpg

Kommentarer.jpg

Sammanställning.jpg

Link to comment
Share on other sites

Kollar bara på fråga1. Vill du inte ha med identiteten på något sätt?

 

Måste du ha 10 variabler? När jag kollar bilden så ser det ut som om du har lika många kolumner i sammanställningen (A:J) som i Mallen (B:K). Med reservation för att jag läser från bild. Så din utgångspunkt för koden kan lika gärna vara 

ActiveWorkbook.Worksheets("Sammanställning").Range("A8:J8").Value= _

ActiveWorkbook.Worksheets(i).Range("B8:K8").Value

 

Sub test()
Dim rMål As Range
Dim rkälla As Range
Dim iStartblad As Integer
Dim i As Integer

Set rMål = ActiveWorkbook.Worksheets("Sammanställning").Range("A8:J8")
iStartblad = 4

For i = iStartblad To ActiveWorkbook.Worksheets.Count
    Set rkälla = ActiveWorkbook.Worksheets(i).Range("B8:K8")
    
    Do While rkälla.Cells(1, 1) <> ""
        rMål.Value = rkälla.Value
        Set rMål = rMål.Offset(1, 0)
        Set rkälla = rkälla.Offset(1, 0)
    Loop
Next i
End Sub

 

i = iStartblad osv är Din yttre loop som hoppar mellan bladen

eftersom nedanstående kod körs i början av loop så återställs rKälla till rad 8 varje gång du byter blad.

Set rkälla = ActiveWorkbook.Worksheets(i).Range("B8:K8")

 

Sen har vi den "inre" loopen som tar en rad i taget när du befinner dig på ett källblad.  Det körs så länge första cellen cells(1,1) i området rKälla har ett innehåll ( <> ""). När värdet är kopierat så flyttas både Mål- och källrad ner en rad och loopen börjar om genom att kolla om första cellen är tom. 

När den har gått igenom alla ifyllda rader (dvs radens B-cell  är tom) så avlutas "do while" och koden hoppar till nästa blad.

 

rMål återställs aldrig så data i sammanställningen fortsätter att flyttas ner när du byter blad

        Do While rkälla.Cells(1, 1) <> ""
            rMål.Value = rkälla.Value
            Set rMål = rMål.Offset(1, 0)
            Set rkälla = rkälla.Offset(1, 0)
        Loop

 

Om du vill ha in namnet kan du testa någonting i stil med

        rMål.Resize(1, 1).Offset(0, 10).Value = ActiveWorkbook.Worksheets(i).Range("c1").Value

 

 

Link to comment
Share on other sites

fråga 2

 

Det här upplägget snodde jag från en sida som jag råkade stänga.

sub Makro1()
Dim wsKommBok As Worksheet
Dim KomBredd As Variant
Dim bBredd As Variant
Dim i As Integer

Set wsKommBok = ThisWorkbook.Worksheets("Kommentarer")

'bredden på kolumnB (utan sammanslagningar)
bBredd = wsKommBok.Range("B1").ColumnWidth


'summera ihop bredden på kolumnB-H (Dvs motsvarande den sammanslagna kolumnen)
For i = 2 To 8
KomBredd = KomBredd + wsKommBok.Cells(1, i).ColumnWidth
Next i

'ta bort rad-sammanslagningen (så att alla kommentarer hamnar i B-kolumen)
' ändra bredden på B-kolumnen så att det är lika bred som den sammanslagna
' Se till att radbrytning är på och fixa automatisk rahöjd
terställ b-kolumnens bredd
'slå ihop Cellerna igen

With wsKommBok.Range("B7:B1000")
.MergeCells = False
.ColumnWidth = KomBredd
.WrapText = True
.RowHeight = 15
.Rows.AutoFit
.ColumnWidth = bBredd
.Resize(, 7).Merge True
End With

End Sub

 

om du vill köra formateringen för en cell i taget när du importerar så kan du hårdkoda bredderna. Exempel om cellen heter MinCell och den sammanslagna kolumnbredden är 70 medan B-kolumnen är 40 bred:

 

With MinCell
.MergeCells = False
.ColumnWidth = 70
.WrapText = True
.RowHeight = 15
.Rows.AutoFit
.ColumnWidth = 40
.Resize(1, 7).Merge True
End With

 

 

 

Link to comment
Share on other sites

Som jag sa så är det första gången jag håller på med VBA men tack för all hjälp. Nu funkar allt klockrent med den nya koden. Fick även till det med autojusteringen också.

Edited by mr Nobody
Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share



×
×
  • Create New...