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

Flytta innehåll systematiskt?

Rekommendera Poster

Hej

 

Jag har en specifikation (från ett webbaserat program) med artikelnummer, artikelnamn, antal och á-pris m.m. som jag har kopierat och klistrat in i excel, formateringen går dock inte att få med.

När jag klistrar in läggs allt innehåll i A-kolumnen, dock med ett korrekt innehåll per cell. Jag provade att spela in ett makro där jag klipper ut och klistrar in samt raderar rader för att ändra strukturen i arbetsboken, men då tillämpas inspelningen bara på de celler jag ändrar. Kan man göra ett makro som successivt flyttar funktionen nedåt? Eller finns det någon annan vettig lösning på mitt problem?

 

Tacksam för hjälp

Anders

Dela detta inlägg


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

Har du testat webbfråga?

Data->Hämta och transformera data ->från Webb

Om du lägger in adressen till din webbsida så kan du oftast hitta "table0" eller liknande som innehåller de data du vill ha. Om det funkar så kan du fixa formatering osv i din "query".

 

Annars. Det är enklast om du visar makrot du har. Dvs klistrar in det makrot du har spelat in. Då kan du få förslag på saker du kan göra. Nu är din fråga lite för luddig.

Dela detta inlägg


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

Okej, jag försöker klargöra lite med att klistra in makrot. När jag spelade in makrot var jag en bit ner i min bok.

 

Sidan jag hämtar ifrån är inte kompatibel med IE 11 står det och visar ett null-värde i tabellen.

 

Makrot ser ut såhär.

Sub Flyttamtrl()
'
' Flyttamtrl Makro
'
' Kortkommando: Ctrl+s
'
    Range("A308").Select
    Selection.Cut
    Range("B307").Select
    ActiveSheet.Paste
    Range("A310").Select
    Selection.Cut
    Range("D307").Select
    ActiveSheet.Paste
    Range("A311").Select
    Selection.Cut
    Range("F307").Select
    ActiveSheet.Paste
    Rows("308:313").Select
    Selection.Delete Shift:=xlUp
    Range("A308").Select
End Sub

 

Dela detta inlägg


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

Vi kan börja med att förenkla det du har och ta bort alla klipp och klistra. Istället tilldelar man målcellerna värdet från källcellerna (vi behöver ju inte klippa ut eftersom du ändå skall ta bort de raderna)

Sub Flyttamtrl2()
    Range("B307").Value = Range("A308").Value
    Range("D307").Value = Range("A310").Value
    Range("F307").Value = Range("A311").Value
    Rows("308:313").Delete Shift:=xlUp
    Range("A308").Select
End Sub

Sen kan du göra om det så att du har en startcell, säg A307 som allt relateras till med hjälp av Offsett och Resize

https://docs.microsoft.com/en-us/office/vba/api/excel.range.offset

https://docs.microsoft.com/en-us/office/vba/api/excel.range.resize

 

Sub Flyttamtrl3()
Dim rStartcell As Range
Set rStartcell = Range("a307")

With rStartcell
    .Offset(0, 1).Value = .Offset(1, 0).Value
    .Offset(0, 3).Value = .Offset(3, 0).Value
    .Offset(0, 5).Value = .Offset(4, 0).Value
    .Offset(1, 0).Resize(6, 1).EntireRow.Delete
End With

Set rStartcell = rStartcell.Offset(1, 0)
End Sub

Offset flyttar cellreferensen ett antal steg ifrån din ursprungspunkt.  Offset(antal rader, antal kolumner)

Den här raden betyder alltså "Cellen ett steg till höger skall får samma värde som cellen Ett steg ner har

    .Offset(0, 1).Value = .Offset(1, 0).Value

 

 

With gör att allt mellan With och End with relateras till Startcell. Man behöver bara skriva .offset (1,0)  istället för  rStartcell.Offset(1, 0). dvs man slipper skriva ut rStartcell 7 gånger och man får lite bättre struktur. 

 

Nu behöver du bara loopa det där. Men du måste ha ett stopp-vilkor (do until). T.ex att motsvarigheten till A308 är tom.

 

Sub Flyttamtrl4()
Dim rStartcell As Range
Set rStartcell = Range("a307")
Do Until rStartcell.Offset(1, 0) = ""
    With rStartcell
        .Offset(0, 1).Value = .Offset(1, 0).Value
        .Offset(0, 3).Value = .Offset(3, 0).Value
        .Offset(0, 5).Value = .Offset(4, 0).Value
        .Offset(1, 0).Resize(6, 1).EntireRow.Delete
    End With
'Här flyttar du ner rStartcell ett steg (set = flytta på riktigt) innan du loopar
Set rStartcell = rStartcell.Offset(1, 0)
Loop
rStartcell.Select
End Sub

 

 

Ähh, som vanligt: använd en kopia och lek runt tills det blir som du vill. 

 

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...