30. juli 2014 - 20:08Der er
7 kommentarer og 1 løsning
Hjælp til en macro kopi kode
Hej Eksperter!
Har brug for lidt hjælp. I meget af min kode bruger jeg når jeg skal kopi op til flere celler "C6:C26"
Men da jeg ikke kan på noget af min kode, ville jeg høre om der var noget der var nemmere af gøre end jeg skal skrive alt ned(bliver lang - da det er op til flere koloner og celler)
udsnit af koden jeg har problemer med.
Range("P5:P26").Select Range("C5").Value = Range("C5").Value + Range("P5").Value Range("C6").Value = Range("C6").Value + Range("P6").Value Range("C7").Value = Range("C7").Value + Range("P7").Value If Range("C5").Value = "0" Then Range("C5").Value = "" End If If Range("C6").Value = "0" Then Range("C6").Value = "" End If If Range("C7").Value = "0" Then Range("C7").Value = "" End If osv.
Kunne godt tænke mig af jeg kunne bare skrive:
Range("C5:C26").Value = Range("C5:C26").Value + Range("P5:P26").Value If Range("C5:C26").Value = "0" Then Range("C5:C26").Value = "" End If
Findes der en løsning på det? eller noget der er smartere? tak på forhånd.
Dim Data1 As Variant, Data2 As Variant Data1 = Range("C5:C26") Data2 = Range("P5:P26") For i = 1 To UBound(Data1) Data1(i, 1) = Data1(i, 1) + Data2(i, 1) If Data1(i, 1) = 0 Then Data1(i, 1) = "" Next Range("C5:C26") = Data1
Synes godt om
Slettet bruger
30. juli 2014 - 21:36#2
Kan ikke få det til at virke, Den kopiere bare helt forkert. du får noget mere af koden (af den lange)
Sub Update() Application.ScreenUpdating = False Sheets("ark2").Activate Sheets("ark2").Range("P5:AD26").Copy Range("P5:AD26").End(xlUp).Offset(1, 0).Activate
Sheets("ark2").Activate Range("P5:AD26").Select Range("C5").Value = Range("C5").Value + Range("P5").Value If Range("C5").Value = "0" Then Range("C5").Value = "" End If Range("C6").Value = Range("C6").Value + Range("P6").Value If Range("C6").Value = "0" Then Range("C6").Value = "" End If Range("C7").Value = Range("C7").Value + Range("P7").Value If Range("C7").Value = "0" Then Range("C7").Value = "" End If Range("C8").Value = Range("C8").Value + Range("P8").Value If Range("C8").Value = "0" Then Range("C8").Value = "" End If Range("C9").Value = Range("C9").Value + Range("P9").Value If Range("C9").Value = "0" Then Range("C9").Value = "" End If Range("C10").Value = Range("C10").Value + Range("P10").Value If Range("C10").Value = "0" Then Range("C10").Value = "" End If Range("C11").Value = Range("C11").Value + Range("P11").Value If Range("C11").Value = "0" Then Range("C11").Value = "" End If Range("C12").Value = Range("C12").Value + Range("P12").Value If Range("C12").Value = "0" Then Range("C12").Value = "" End If Range("C13").Value = Range("C13").Value + Range("P13").Value If Range("C13").Value = "0" Then Range("C13").Value = "" End If Range("C14").Value = Range("C14").Value + Range("P14").Value If Range("C14").Value = "0" Then Range("C14").Value = "" End If Range("C15").Value = Range("C15").Value + Range("P15").Value If Range("C15").Value = "0" Then Range("C15").Value = "" End If Range("C16").Value = Range("C16").Value + Range("P16").Value If Range("C16").Value = "0" Then Range("C16").Value = "" End If Range("C17").Value = Range("C17").Value + Range("P17").Value If Range("C17").Value = "0" Then Range("C17").Value = "" End If Range("C18").Value = Range("C18").Value + Range("P18").Value If Range("C18").Value = "0" Then Range("C18").Value = "" End If Range("C19").Value = Range("C19").Value + Range("P19").Value If Range("C19").Value = "0" Then Range("C19").Value = "" End If Range("C20").Value = Range("C20").Value + Range("P20").Value If Range("C20").Value = "0" Then Range("C20").Value = "" End If Range("C21").Value = Range("C21").Value + Range("P21").Value If Range("C21").Value = "0" Then Range("C21").Value = "" End If Range("C22").Value = Range("C22").Value + Range("P22").Value If Range("C22").Value = "0" Then Range("C22").Value = "" End If Range("C23").Value = Range("C23").Value + Range("P23").Value If Range("C23").Value = "0" Then Range("C23").Value = "" End If Range("C24").Value = Range("C24").Value + Range("P24").Value If Range("C24").Value = "0" Then Range("C24").Value = "" End If Range("C25").Value = Range("C25").Value + Range("P25").Value If Range("C25").Value = "0" Then Range("C25").Value = "" End If Range("C26").Value = Range("C26").Value + Range("P26").Value If Range("C26").Value = "0" Then Range("C26").Value = "" End If
Kopieres fra. P5:AD26 til C5:E26 - P26:N26 (Der er et mellemrum pga. design som er kolonne F)
Ja. okej. jeg forklare mig nok lidt forkert. Din kode virker. Men ikke når jeg sætter flere kolonner ind i den.
Din kode kopiere og plusser en kolonne til en anden. men har 10 kolonner mere som skal kopieres over til nogle andre.
Den første var: Fra P5:P26 Til C5:C26
Resten: Fra Q5:Q26 Til D5:D26 Fra R5:R26 Til E5:E26 Fra S5:S26 Til G5:G26 Fra T5:T26 Til H5:H26 Fra U5:U26 Til I5:I26 Fra V5:V26 Til J5:J26 Fra W5:W26 Til K5:K26 Fra X5:X26 Til L5:L26 Fra Y5:Y26 Til M5:M26 Fra Z5:Z26 Til N5:N26
Sub Update() 'Application.ScreenUpdating = False 'Sheets("ark2").Activate 'Sheets("ark2").Range("P5:AD26").Copy ' Range("P5:AD26").End(xlUp).Offset(1, 0).Activate ' ActiveCell.PasteSpecial , Operation:=xlNone, SkipBlanks:=True, Transpose:=False ' Dim Data1 As Variant, Data2 As Variant For a = 3 To 14 Data1 = Range(Cells(5, a), Cells(26, a)) 'fra kolonne C til N Data2 = Range(Cells(5, a + 13), Cells(26, a + 13)) 'fra kolonne P til Z For i = 1 To UBound(Data1) Data1(i, 1) = Data1(i, 1) + Data2(i, 1) If Data1(i, 1) = 0 Then Data1(i, 1) = "" Next Range(Cells(5, a), Cells(26, a)) = Data1 Next End Sub
Sub Update() 'Application.ScreenUpdating = False 'Sheets("ark2").Activate 'Sheets("ark2").Range("P5:AD26").Copy ' Range("P5:AD26").End(xlUp).Offset(1, 0).Activate ' ActiveCell.PasteSpecial , Operation:=xlNone, SkipBlanks:=True, Transpose:=False ' Dim Data1 As Variant, Data2 As Variant Dim Col As Integer, I As Integer Col = 13 For A = 3 To 14 If A = 6 Then A = 7 Col = 12 End If
Data1 = Range(Cells(5, A), Cells(26, A)) 'fra kolonne C til N men hopper over F Data2 = Range(Cells(5, A + Col), Cells(26, A + Col)) 'fra kolonne P til Z For I = 1 To UBound(Data1) Data1(I, 1) = Data1(I, 1) + Data2(I, 1) If Data1(I, 1) = 0 Then Data1(I, 1) = "" Next Range(Cells(5, A), Cells(26, A)) = Data1 Next End Sub
Synes godt om
Slettet bruger
31. juli 2014 - 14:33#8
Tjekker kode når jeg kommer hjem. Men ellers lukker jeg det bare nu.
Synes godt om
Ny brugerNybegynder
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.
