Kirjautuminen

Haku

Tehtävät

Kilpailu

Putka Open 2025
4. kierros:
7.11. klo 18 – 9.11. klo 23

Keskustelu: Ohjelmointikysymykset: VBA: Alemman taulukon siirto, kun ylempään lisätään rivi

jannekala [09.04.2013 17:02:28]

#

Yksi ongelma lisää tuli mieleen josta tahtoisin kysyä:

Minulla on kaksi taulukkoa päällekkäin, ja kun poistan ylemmästä rivin, siirtyy alempi taulukko rivin ylöspäin. Mutta kun ylempään taulukkoon lisää rivin, alempi taulukko ei liikukaan mukana vaan tiedot menevät päällekkäin. Miten siis saisin alemman taulukon liikkumaan ylemmän taulukon mukana, ja miten viittaukset hoituvat sitten?

(Mod. teki uudesta kysymyksestä uuden keskustelun.)

anneli [18.04.2013 00:51:10]

#

1. Millä komennolla lisäät rivin ylempään taulukkoon?

neau33 [18.04.2013 07:46:16]

#

Moi!

oletan, että kysymys liittyy aiempaan viestiin koskapa moderaattori meni ja teki tästä uuden keskustelun...

oletetaan, että halutaan lisätä ja poistaa rivejä (yksi rivi kerrallaan) komentopainikkeen avulla taulukosta Taul1 niin, että toiminnot vaikuttavat taulukon Taul2 vastaaviin riveihin.
Lisää taulukkoon Taul1 2 ActiveX komentopainiketta (CommandButton1 & CommandButton2). Kilkkaa vuorollaan kutakin komentonappia hiiren oikealla, valitse Muokkaa ohjausobjektia ja poista suojaus välilehdellä Lukittu ruudun rasti. Lisää taulun Taul1 ensimmäiselle riville muutamaan sarakkeeseen haluamiasi sarakeotsikoita, kopio ne vastaaviin taulun Taul2 soluhin ja lisää komentonappien koodit:

'Taul1
Private Sub CommandButton1_Click() 'Lisää rivi

    Taul1.Unprotect Password:="salasana"
    Taul2.Unprotect Password:="salasana"

    If Selection.Row = 1 Then
        Rows(2).Select
    Else
        Rows(Selection.Row).Select
    End If

    If Selection.Row <= UsedRange.SpecialCells(xlCellTypeLastCell).Row Then
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ElseIf Selection.Row > UsedRange.SpecialCells(xlCellTypeLastCell).Row Then
        Rows(UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Select
    End If

    rivi = Selection.Row

    For sarake = 1 To UsedRange.SpecialCells(xlCellTypeLastCell).Column
        arvo = InputBox("Syötä solun " & Replace(Cells(rivi, sarake).Address, "$", "") & " arvo")
        Cells(rivi, sarake).Value = arvo
    Next

    Application.ScreenUpdating = False

    Taul2.Activate
    Taul2.Rows(rivi).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Taul1.Rows(rivi).Copy Destination:=Taul2.Range("A" & rivi)
    Taul1.Activate

    Taul2.Protect Password:="salasana", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Taul1.Protect Password:="salasana", DrawingObjects:=True, Contents:=True, Scenarios:=True

    Application.ScreenUpdating = True

End Sub

Private Sub CommandButton2_Click() 'Poista rivi

    rivi = Selection.Row

    If rivi = 1 Then
        MsgBox "Et voi poistaa otsikkoriviä"
        Exit Sub
    End If

    Taul1.Unprotect Password:="salasana"
    Taul2.Unprotect Password:="salasana"


    If rivi <= UsedRange.SpecialCells(xlCellTypeLastCell).Row Then
        Taul1.Rows(rivi).Delete
        Taul2.Rows(rivi).Delete
    End If

    Taul2.Protect Password:="salasana", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Taul1.Protect Password:="salasana", DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Suojaa sen jälkeen molemmat taulukot asettamalla salasanaksi salasana ja tallenna työkirja makrot sallivaan muotoon.


Mikäli taas halutaan, että taulun Taul1 muutokset vaikuttavat suoraan taulun Taul2 solujen arvoihin niin tässä (vain) yksi esimerkki...

'Taul1
Private Sub Worksheet_Change(ByVal Target As Range)

    'jos taulussa Taul2 on käytössä enemmän rivejä, kuin 1 niin...
    If Taul2.UsedRange.SpecialCells(xlCellTypeLastCell).Row > 1 Then
        'tyhjennetään alue "A2:" & viimeisen käytössä olevan solun osoite
        Taul2.Range("A2:" & Taul2.UsedRange.SpecialCells(xlCellTypeLastCell).Address).Clear
        'jolloin ensimmäisen ('otsikkorivin') rivin tiedot säilyvät
    End If

    'asetetaan muuttujan arvoksi taulun Taul1
    'viimeisen käytössä olevan solun rivi
    rivi = Taul1.UsedRange.SpecialCells(xlCellTypeLastCell).Row

    'jos muuttujan arvo on suurempi kuin 1 niin...
    If rivi > 1 Then
        'kopioidaan  solualue joka muodostuu taulun Taul1 sarakkeen
        'A riveistä 2 - rivi ja sarakkeen C riveistä 2 - rivi
        'tauluun Taul2 alkaen solusta A2 jolloin ko. solualue
        'kopioituu sarakkeisiin A - B
        Taul1.Range("A2:A" & rivi & "," & "C2:C" & rivi).Copy Destination:=Taul2.Range("A2")
    End If

End Sub

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta