Új hozzászólás Aktív témák

• #37466 tgumis tag

  Új Válasz 2018-03-07 00:06:47 #37466

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  tgumis

  tag

  Sziasztok
  Adott ez a makró:
  Sub beillesztes()
'
' előre másik munkalapból kimásolt 4 oszlop szélességü tartományt beilleszt a B oszlop első üres sorától
' kezdve a B oszloptól az E oszlopig majd az A oszlopot kitölti sorszámmal illetve az T oszloptól az X oszlopig
' az T2:X2 tartomány képleteit másolja be addig a sorig ameddig a B oszlop tartalmaz elemet
'

Dim Asor As Long
Dim Bsor As Long
Dim i As Integer

Asor = Range("A" & Rows.Count).End(xlUp).Row + 1

Range("B" & Asor).PasteSpecial xlPasteValues

Bsor = Range("B" & Rows.Count).End(xlUp).Row + 1
Range("T2:X2").Copy Destination:=Range("T" & Asor & ":T" & Bsor - 1) 'a végén a -1 azt jelzi hogy nem az utlsó kitöltött
' sor plusz egy sorba másolja a képletet hanem csak az utolsó sorig

For i = Asor To Bsor - 1 'számláló rész a Bsor esetén plusz egy sort beszámoz viszont ha csak a kitöltött celláig akarunk számozni akkor a-1 kell
Range("A" & i) = Range("A" & i - 1) + 1
Next i

'innen kezdődik a keretezés
Range("A1").CurrentRegion.Select 'CTRL+a kijelöli a teljes táblázatot
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Range("A1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With


End Sub
Sub beillesztes__()


'
' előre másik munkalapból kimásolt 4 oszlop szélességü tartományt beilleszt a B oszlop első üres sorától
' kezdve a B oszloptól az E oszlopig majd az A oszlopot kitölti sorszámmal illetve az F oszloptól az L oszlopig
' az F2:L2 tartomány képleteit másolja be addig a sorig ameddig a B oszlop tartalmaz elemet
'

Dim Bsor As Long
Dim Csor As Long
Dim i As Integer

Bsor = Range("B" & Rows.Count).End(xlUp).Row + 1

Range("C" & Bsor).PasteSpecial xlPasteValues

Csor = Range("C" & Rows.Count).End(xlUp).Row + 1
Range("T2:V2").Copy Destination:=Range("T" & Bsor & ":T" & Csor - 1) 'a végén a -1 azt jelzi hogy nem az utlsó kitöltött
' sor plusz egy sorba másolja a képletet hanem csak az utolsó sorig

For i = Bsor To Csor - 1 'számláló rész a Bsor esetén plusz egy sort beszámoz viszont ha csak a kitöltött celláig akarunk számozni akkor a-1 kell
Range("B" & i) = Range("B" & i - 1) + 1
Next i

'innen kezdődik a keretezés
Range("B1").CurrentRegion.Select 'CTRL+a kijelöli a teljes táblázatot
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Range("B1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
End Sub

  A lényege hogy egy 17 oszlop széles tartomány (amit egy mások munkalapról másolok egy másik makróval) beilleszti a B oszlop első üres sorába majd másolja a képleteket.
  vagyis másolná:
  hiába van ez a képlet a U2 cellában ez a képlet =SZUM($K$22) ahogy lefut a makró átírja a képletet
  U3 cellá:=SZUM($K$23)
  U4 cella:=SZUM($K$25)
  U 5 cella:=SZUM($K$25)

  illetve az X 2 ben hiába van ez a képlet =W2+SZUMHA($V$2:V2;V2;$T$2:T2)
  az X3 ba ez lesz:=W3+SZUMHA($V$2:V3;V3;$T$2:T3) ez jó
  az X4 ben meg ez: =W4+SZUMHA($V$2:V5;V4;$T$2:T5) ez hibás
  az X5 ben meg ez :=W5+SZUMHA($V$2:V5;V5;$T$2:T5) ez is jó

  van ötlete valakinek?

Új hozzászólás Aktív témák