Keskustelu: Ohjelmointikysymykset: VBA: Excel ja valinta sarakkeen lopusta

Taavetti [16.01.2012 16:13:03]

Ajan työssäni SAP BWsta exceliin raakadataa ja sitä sitten sortataan ja analysoidaan useissa eri excel taulukoissa. Edeltänäni tässä työssä on luonut muutamia toimivia makroja, mutta vielä on paljon manuaalista copy-paste toimintaa josta haluasin päästä eroon.

Kysymys: nauhoittamalla makron tai kirjoittamalla koodia VBA:lla on helppo valita jokin tietty kiinteä solualue. Mutta kuinka valitaan taulukon loppupäästä aina esim. viimeiset 5 solua sarakkeesta A? Joka päivä/viikko/kuukausi (riippuen taulusta) taulun rivimäärä lisääntyy ja siksi kiinteä alueviittaus ei toimi. Tämä on varmasti tosi yksinkertaista mutta kun ohjelmointikokemusta ei ole ja vasta viime viikolla tein ensimmäisiä alkeellisia pätkiä VBA:lla, niin en vielä keksinyt tähän ratkaisua.

Kiitos vastauksista jo etukäteen!

Meitzi [16.01.2012 20:09:32]

Tässä yksi vaihtoehto.

Sub ValitseLoppu()
    Dim I As Long
    'Etsitään ensimmäinen tyhjä solu sarakkeesta A
    For I = 1 To 65000
        If Cells(I, "A").Value = "" Then Exit For
    Next I
    'Valitaan tyhjän solun yläpuolelta 5 riviä
    Range("A" & I - 1 & ":A" & I - 6).Select
End Sub

Taavetti [16.01.2012 20:31:55]

Thanks Meitzi! Täytyy kokeilla huomenna että miten toimii. Selkeä ohje, kiitos!

neau33 [16.01.2012 21:13:16]

Moro Taavetti!

testaa oheista simppeliä viritelmää...

'ThisWorkbook
Private Sub Workbook_Activate()
    'kutsutaan aliohjelmaa, joka lisää
    'työkirjaan työkalurivin ja lisää siihen
    'yhden komentopainikkeen...
    AddCmdBar
End Sub

Private Sub Workbook_Deactivate()
    'kutsutaan aliohjelmaa joka
    'poistaa luodun työkalurivin ja
    'siinä olevan komentopainikkeen
     RemoveCmdBar
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    'Jos VBA-lomake on näkyvissä niin...
    If UserForm1.Visible Then
        'kutsuataan seuraavia aliohjelmia:
        InitTaulut
        InitSarakkeet
        AsetaVRiviSarake
        'asetetaan lomakkeen comboboxin
        'listindex arvoksi aktiivisen taulun index
        'arvo vähennettynä yhdellä...
        UserForm1.ComboBox1.ListIndex = ActiveSheet.Index - 1
        'kutsutaan lomakkeelta aliohjelmaa
        'joka asettaa valintojen arvot vastaamaan
        'aktiivisen laskentataulkon vallitsevia asetuksia.
        UserForm1.InitTaulukosta
    End If

End Sub

'Module1
'Alustetaan globaalit muuttujat
Global Taulut() As String
Global vrivi As Long
Global vsarake As Long
Global Sarakkeet() As String

Sub InitTaulut()

    'alustetaan paikalliset muuttujat
    Dim ws As Worksheet
    Dim cnt As Integer: cnt = -1

    ReDim Taulut(ThisWorkbook.Sheets.Count - 1)

    'aseteaan työkirjan laskentataulukoiden nimet
    'merkkijonotyyppiseen taulukkomuuttujaan...
    For Each ws In ThisWorkbook.Worksheets
        cnt = cnt + 1
        With ws
            Taulut(cnt) = .Name
        End With
    Next

End Sub

Sub InitSarakkeet()

   'alustetaan paikalliset muuttujat...
    Dim i As Integer: Dim tmp() As String
    ReDim Sarakkeet(Sheets(1).Columns.Count - 1)

    'aseteaan taulukkomuuttujan alkioiden
    'arvoiksi sarakkeiden kirjainmääritteet...
    For i = 0 To UBound(Sarakkeet)
        tmp = Split(Replace(Sheets(1).Columns( _
        i + 1).Address, "$", ""), ":")
        Sarakkeet(i) = tmp(0)
        Erase tmp
    Next

End Sub

Sub UserFormShow()

    'Jos VBA-lomake ei ole näkyvissä
    'ja työkalupalkin komentopainiketta
    '(Näytä Lomake)kilkataan niin ko.
    'lomake tuodaan esiin...
    If Not UserForm1.Visible Then
        UserForm1.Show 0
    End If

End Sub

Sub AsetaVRiviSarake()

    'asetetaan muuttujan (vrivi) arvoksi
    'aktiivisen laskentataulukon viimeisen
    'käytössä olevan rivin indeksi...
    vrivi = ActiveSheet.Cells.SpecialCells( _
    xlCellTypeLastCell).Row

    'asetetaan muuttujan (vsarake) arvoksi
    'aktiivisen laskentataulukon viimeisen
    'käytössä olevan sarakkeen indeksi...
    vsarake = ActiveSheet.Cells.SpecialCells( _
    xlCellTypeLastCell).Column

End Sub

Sub AddCmdBar()

    'yritetään ensin poistaa mahdollisen virhe-
    'tilanteen yhteydessä projektiin mahdollisesti
    'jäänyt työkalurivi ennen uuden luomista...
    RemoveCmdBar

    On Error Resume Next
    'alustetaan objektimuuttujat....
    Dim CmdBar As CommandBar
    Dim CmdBtn As CommandBarButton

    'luodaan objektit jne...
    Set CmdBar = Application.CommandBars.Add(Name:= _
    "VBALOMAKE", Position:=msoBarTop, Temporary:=True)
    CmdBar.Visible = True

    Set CmdBtn = CmdBar.Controls.Add( _
    Type:=msoControlButton, ID:=2949, Before:=1)

    With CmdBtn
        .Caption = "&Näytä lomake"
        .Style = msoButtonCaption
        .OnAction = "UserFormShow"
    End With

    If Err <> 0 Then
        Err.Clear: On Error GoTo 0
    End If

End Sub

Sub RemoveCmdBar()

    'poistetaan luotu painike ja työkalurivi
    On Error Resume Next
    Application.CommandBars("VBALOMAKE").Controls(1).Delete
    Application.CommandBars("VBALOMAKE").Delete

    If Err <> 0 Then
        Err.Clear: On Error GoTo 0
    End If

End Sub

'UserForm1
Private sallitut() As String

Private Sub UserForm_Activate()

    'Lomakkeen ohjauobjektit:
    '3 ComboBoxia (ComboBox1...ComboBox3)
    '1 Tekstiruutu    (TextBox1)
    '2 Radionappia (OptionButton1 & OptionButton2)
    1 Komentopainike (CommandButton1)

    'kutsutaan aliohjelmia...
    InitTaulut
    InitSarakkeet
    AsetaVRiviSarake

    'alustetaan objektien ominaisuusarvot
    ComboBox1.Style = fmStyleDropDownList
    ComboBox2.Style = fmStyleDropDownList
    ComboBox3.Style = fmStyleDropDownList
    ComboBox1.List = Taulut
    ComboBox1.ListIndex = ActiveSheet.Index - 1
    ComboBox2.List = Sarakkeet
    ComboBox3.List = Sarakkeet
    ComboBox2.ListIndex = 0
    OptionButton1.Value = True
    'täytetään taulukkomuuttuja
    sallitut = Split("1,2,3,4,5,6,7,8,9,0", ",")

End Sub

Private Sub ComboBox1_Change()

    'kun comboboxin valintaa muutetaan
    'aktivoidaan comboboxin tekstiarvoa
    'vastaava laskentataulukko...
    If ComboBox1.Text <> "" Then
        Sheets(ComboBox1.Text).Activate
    End If

End Sub

Private Sub ComboBox2_Change()

    'tutkitaan comboboxin valinnan muuttumisen
    'yhteydessä ylittyytkö asetetut rajaarvot...
    If ComboBox2.ListIndex > vsarake - 1 Then
        MsgBox "Valittu sarake ylittää käytetyn alueen"
        ComboBox2.ListIndex = vsarake - 1
    End If

    ComboBox3.ListIndex _
    = ComboBox2.ListIndex

End Sub

Private Sub ComboBox3_Change()

    'tutkitaan comboboxin valinnan muuttumisen
    'yhteydessä ylittyytkö asetetut raja-arvot...
    If ComboBox3.ListIndex > vsarake - 1 Then
        MsgBox "Valittu sarake ylittää käytetyn alueen"
        ComboBox3.ListIndex = vsarake - 1
    End If

End Sub

Private Sub CommandButton1_Click()

    'alustetaan paikalliset muuttujat...
    Dim i As Long, alue As Range

    'ehdollistetaan koodin suoritustapa
    'valintapainikkeen Value -arvon mukaan...
    If OptionButton1.Value = True Then
        Set alue = Range(ComboBox2.Text & "1:" _
        & ComboBox3.Text & TextBox1.Text)
        alue.Select: Set alue = Nothing
    Else
        Dim erivi As Long: erivi = _
        vrivi - CLng(TextBox1.Text) + 1
        Set alue = Range(ComboBox2.Text & CStr( _
        erivi) & ":" & ComboBox3.Text & CStr(vrivi))
        alue.Select: Set alue = Nothing
    End If

End Sub

Private Sub TextBox1_Change()

    If Len(TextBox1.Text) > 0 Then

        'tutkitaan onko ensimmäisen merkin arvo 0
        If Val(Left(TextBox1.Text, 1)) = 0 Then
            TextBox1.Text = "1": Exit Sub
        End If

        'alustetaan paikalliset muuttujat...
        Dim i As Integer
        Dim tmp As String
        Dim validi As Boolean

        'tutkitaan syötettyjen merkkien kelvollisuus jne...
        For i = 1 To Len(TextBox1.Text)

            validi = False

            For j = 0 To UBound(sallitut)
                If Mid(TextBox1.Text, i, 1) = sallitut(j) Then
                    validi = True: Exit For
                End If
            Next j

            If validi Then
                tmp = tmp + Mid(TextBox1.Text, i, 1)
            End If

        Next i

        TextBox1.Text = tmp

    End If

    If Val(TextBox1.Text) > vrivi Then
        MsgBox "Rivimäärä ylittää käytetyn alueen!"
        TextBox1.Text = CStr(vrivi)
    End If

    TextBox1.SelStart = Len(TextBox1.Text)

End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    'jos tekstiruutuun jäi tyhjäke poistuttaessa
    'niin asetetaan ko. objektin merkkijonoarvoksi: "1"
    If TextBox1.Text = "" Then
        TextBox1.Text = "1"
    End If

End Sub

Public Sub InitTaulukosta()

    'asetetaan lomakkeen objektien ominaisuusarvot
    'vastaamaan aktiivisen laskentataulukon asetuksia
    '(tätä kutsutaan, kun laskentataulukko aktivoidaan)
    If ComboBox2.ListIndex > vsarake - 1 Then
        ComboBox2.ListIndex = vsarake - 1
    End If

    If ComboBox3.ListIndex > vsarake - 1 Then
        ComboBox3.ListIndex = vsarake - 1
    End If

    If Val(TextBox1.Text) > vrivi Then
        TextBox1.Text = CStr(vrivi)
    End If

End Sub

Mikäli jotain on epäselvää niin imppaa täältä valmis Excel(2003)/VBA-projekti+.

Taavetti [17.01.2012 10:24:40]

Lähetänpä tässä aiheeseen liittyvä nauhoitetun makron. Yritin muokata tuota niin, että poistin "valitaan ensimmäinen kopioitava tieto..." alta molemmat Range -valinnat ja lisäsin tilalle Meitzin lähettämän pätkän ilman sub/end subia. "A" tilalle laitoin "AA" kuten makroesimerkin Range valinnassakin. Ei toiminut. Kiitos myös Neau33:lle, vastauksessasi on kenties ratkaisu ongelmaan. En vain tällä parin päivän makron nauhoitus/VBA kokemuksella kykene hahmottamaan sitä, simmpeliydestään huolimatta...Taavetti

Mod. lisäsi kooditagit!

Sub weekly_update()
'
' weekly_update Makro
' tämä on nauhoitettu makro ja tässä ongelmana kiinteä alueviittaus. Kopioitava alue tulisi olla kussakin kopiointitapahtumassa sarakkeen viisi viimeisintä arvoa. Jos viimeinen arvo on kuitenkin nolla, niin kopioitavat arvot ovat sarakkeen viisi viimeistä suurempi kuin nolla (>0) arvoa.

Windows("Orders & operating rate 2012.xls").Activate
'tyhjennetään vanhat arvot, turhaan tosin, mutta näkyypähän kohdealue.
    Range("F7:J14,F17:J20,F24:J27,F30:J31,F35:J38").Select
    Range("F35").Activate
    Selection.ClearContents
'valitaan ensimmäinen kopioitava tieto ja liitetään transponoimalla
    Windows("Ca order inflow.xls").Activate
    Range("AA265:AA269").Select
    Range("AA269").Activate
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan toinen kopioitava tieto ja liitetään transponoimalla
    Windows("Ca order inflow.xls").Activate
    Range("AB265:AB269").Select
    Range("AB269").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan kolmass kopioitava tieto ja liitetään transponoimalla
    Windows("Ca order inflow.xls").Activate
    Range("AC265:AC269").Select
    Range("AC269").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan neljäs kopioitava tieto ja liitetään transponoimalla
    Windows("Ca order inflow.xls").Activate
    Range("AG265:AG269").Select
    Range("AG269").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan viides kopioitava tieto ja liitetään transponoimalla
    Windows("Ca order inflow.xls").Activate
    Range("D265:D269").Select
    Range("D269").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan kuudes kopioitava tieto ja liitetään transponoimalla
    Windows("Ca order inflow.xls").Activate
    Range("E265:E269").Select
    Range("E269").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F20").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan seitsemäs kopioitava tieto ja liitetään transponoimalla
    Windows("orderstocks new organisation.XLS").Activate
    Sheets("Home Office data").Select
    ActiveWindow.SmallScroll Down:=-3
    Range("I210:I214").Select
    Range("I214").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan kahdeksas kopioitava tieto ja liitetään transponoimalla
    Windows("orderstocks new organisation.XLS").Activate
    Range("U210:U214").Select
    Range("U214").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan yhdeksäs kopioitava tieto ja liitetään transponoimalla
    Windows("orderstocks new organisation.XLS").Activate
    Sheets("Speciality Papers").Select
    Range("K210:K214").Select
    Range("K214").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan kymmenes kopioitava tieto ja liitetään transponoimalla
    Windows("orderstocks new organisation.XLS").Activate
    Range("I210:I214").Select
    Range("I214").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan yhdestoista kopioitava tieto ja liitetään transponoimalla
    Windows("order inflow.xls").Activate
    Sheets("Order Inflow data").Select
    Range("AN108:AN112").Select
    Range("AN112").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan kahdestoista kopioitava tieto ja liitetään transponoimalla
    Windows("order inflow.xls").Activate
    Range("AO108:AO112").Select
    Range("AO112").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan kolmastoista kopioitava tieto ja liitetään transponoimalla
    Windows("order inflow.xls").Activate
    Range("AQ108:AQ112").Select
    Range("AQ112").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan neljästoista kopioitava tieto ja liitetään transponoimalla
    Windows("order inflow.xls").Activate
    Range("AP108:AP112").Select
    Range("AP112").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan viidestoista kopioitava tieto ja liitetään transponoimalla
    Windows("order inflow.xls").Activate
     Range("P108:P112").Select
    Range("P112").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan kuudestoista kopioitava tieto ja liitetään transponoimalla
    Windows("order inflow.xls").Activate
     Range("BJ108:BJ112").Select
    Range("BJ112").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan seitsemästoista kopioitava tieto ja liitetään transponoimalla
    Windows("order inflow.xls").Activate
    Sheets("Office papers").Select
    Range("B109:B113").Select
    Range("B113").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan kahdeksastoista kopioitava tieto ja liitetään transponoimalla
    Windows("order inflow.xls").Activate
    Range("C109:C113").Select
    Range("C113").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan yhdeksästoista kopioitava tieto ja liitetään transponoimalla
    Windows("order inflow.xls").Activate
    Range("F109:F113").Select
    Range("F113").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
'valitaan kahdeskymmenes kopioitava tieto ja liitetään transponoimalla
    Windows("order inflow.xls").Activate
    Sheets("Speciality").Select
    Range("J109:J113").Select
    Range("J113").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Windows("order inflow.xls").Activate
    ActiveWindow.SmallScroll Down:=-75
    Windows("Orders & operating rate 2012.xls").Activate
    Range("F37").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
End Sub

Mod. lisäsi kooditagit!

Taavetti [17.01.2012 16:44:19]

Eli tällaisella allaolevalla pätkällä testasin juuri äsken. Tarkoitus oli testimielessä valita "Ca order inflow.xls" -taulusta AA sarakkeen viisi alinta solua, eli makronauhoituksen ensimmäisen kopioitavan tiedon valinta ("AA265:AA269"). Ei toiminut tuo valinta. Keltaiseksi meni tämä:
Range("AA" & I - 1 & ":AA" & I - 6).Select
Mitähän tein väärin?
yst.terveisin, Taavetti

Sub testi1()
'
' testi1 Makro
'

'
    Windows("Ca order inflow.xls").Activate
    Dim I As Long
    'Etsitään ensimmäinen tyhjä solu sarakkeesta A
    For I = 1 To 65000
        If Cells(I, "AA").Value = "" Then Exit For
    Next I
    'Valitaan tyhjän solun yläpuolelta 5 riviä
    Range("AA" & I - 1 & ":AA" & I - 6).Select

    Selection.Copy
    Windows("Orders & operating rate 2012.xls").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
End Sub

Mod. huom: Ainakin kooditagit teit väärin. Ole hyvä ja lue keskustelun ohjeet!

neau33 [17.01.2012 17:14:49]

Moi taas Taavetti!

On tosi nastaa, että tutkit/kokeilet/yhdistät koodia, mutta tutki ja testaa oheista viritelmää ensin ihan sellaisenaan...

'Työkirjan 'Ca order inflow.xls'
'laskentataulukkoon 'Taul1' sijoitetun
'komentopainikkeen Click_tapahtuman koodi...

'koodin suorittaminen kopioi 'Taul1' viiden viimeismmän käytetyn
'sarakkeen viiden viimeisimmä arvon sisältävän solun arvon ensin
'väliaikaisen taulun 'temp'  alueelle ("A1:E5"), josta arvot kopioidaan
'edelleen sarkkeittain työkirjan 'Orders & operating rate 2012.xls
'laskentataulukon 'Taul1' (target_Sheet) viiden viimeisimmän käytössä
'olevan ei tyhjän sarakkeen viiteen ensimmäiseen tyhjään soluun.

Private Sub CommandButton1_Click()

   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

   Dim IsOpen As Boolean
   Dim wk As Workbook
   Dim ws As Worksheet
   Set ws = ThisWorkbook.Sheets("Taul1")

   For Each wk In Workbooks
      With wk
         If .Name = "Orders & operating rate 2012.xls" Then
            IsOpen = True: Exit For
         End If
      End With
   Next

   If Not IsOpen Then
      'Huom! molempien .xls tiedostojen
      'tulee sijaita samassa kansiossa
      Dim xlPath As String
      xlPath = Replace(ActiveWorkbook.FullName, ActiveWorkbook.Name, "")
      Workbooks.Open xlPath & "Orders & operating rate 2012.xls"
   End If

   ThisWorkbook.Activate
   ws.Activate

   Dim lastrow As Long, lastcol As Long, i As Long
   lastrow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
   lastcol = ws.Cells.SpecialCells(xlCellTypeLastCell).Column

   For i = lastrow To 1 Step -1
      If Application.CountA(ws.Rows(i).EntireRow) <> 0 Then
         Exit For
      End If
      If i = 1 Then Exit For
      lastrow = i
   Next

   For i = lastcol To 1 Step -1
      If Application.CountA(ws.Columns(i).EntireColumn) <> 0 Then
         Exit For
      End If
      If i = 1 Then Exit For
      lastcol = i
   Next

   Dim startrow As Long, startcol As Long

   If lastcol > 5 Then
      startcol = lastcol - 5
   Else
      startcol = 1
   End If

   On Error Resume Next
   ThisWorkbook.Sheets("temp").Delete

   If Err <> 0 Then
      Err.Clear
      On Error GoTo 0
   End If

   ThisWorkbook.Worksheets.Add
   ActiveSheet.Name = "temp"
   ws.Activate

   Dim rowcoun As Integer
   Dim colcount As Integer

   For i = startcol To lastcol
      rowcount = 6
      colcount = colcount + 1
      For j = lastrow To 1 Step -1
         If Cells(j, i).Value > 0 Then
            rowcount = rowcount - 1
            Sheets("temp").Cells(rowcount, _
            colcount).Value = Cells(j, i).Value
         End If
         If rowcount = 1 Then Exit For
      Next j
   Next i

   Dim target_Sheet As Worksheet
   Dim target_lastrow As Long
   Dim target_lastcol As Long

   Set target_Sheet = _
   Workbooks("Orders & operating rate 2012.xls").Sheets("Taul1")
   target_lastrow = target_Sheet.Cells.SpecialCells(xlCellTypeLastCell).Row
   target_lastcol = target_Sheet.Cells.SpecialCells(xlCellTypeLastCell).Column

   For i = target_lastrow To 1 Step -1
      If Application.CountA(target_Sheet.Rows(i).EntireRow) <> 0 Then
         Exit For
      End If
      If i = 1 Then Exit For
      target_lastrow = i
   Next

   For i = target_lastcol To 1 Step -1
      If Application.CountA(target_Sheet.Columns(i).EntireColumn) <> 0 Then
         Exit For
      End If
      If i = 1 Then Exit For
      target_lastcol = i
   Next

   Dim target_startcol As Long
   Dim target_endcol As Long

   If target_lastcol < 5 Then
      target_startcol = 1
   Else
      target_startcol = target_lastcol - 4
   End If

   target_endcol = target_startcol + 4
   Dim target_row As Long, _
   source_address As String, _
   address_parts() As String, _
   target_address As String

   colcount = 0

   For i = target_startcol To target_endcol

      colcount = colcount + 1
      target_row = target_lastrow + 1

      For j = target_lastrow To 1 Step -1
         If target_Sheet.Cells(j, i).Value <> "" Then
            Exit For
         End If
         target_row = j
      Next j

      address_parts = Split(Replace(Sheets("temp").Columns( _
      colcount).address, "$", ""), ":")
      source_address = address_parts(0) & "1:" & address_parts(0) & "5"
      target_address = Replace(target_Sheet.Cells( _
      target_row, i).address, "$", "")
      target_address = target_address & ":" & target_address
      ThisWorkbook.Sheets("temp").Range(source_address).Copy _
      target_Sheet.Range(target_address)
      Erase address_parts

   Next i

   Set target_Sheet = Nothing

   ThisWorkbook.Sheets("temp").Delete
   Workbooks("Orders & operating rate 2012.xls").Save
   Workbooks("Orders & operating rate 2012.xls").Close
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True

End Sub

Halutessasi voit impata täältä valmiin Excel(2003)/VBA-projektin

Taavetti [17.01.2012 18:38:00]

Kiitos Nea! Kokeilen taas töissä huomenna.

Kommenttiin: "Mod. huom: Ainakin kooditagit teit väärin. Ole hyvä ja lue keskustelun ohjeet!"

Vastaan, että luin kyllä ohjeet ja katsoin mallia Nean ja Meitzin kooditageista. Valitettavasti en tiedä/osaa erotella tuolta koodista oleellista. Ja nyt huomasin, että Ohjelmointiputkan etusivulla lukee "Ohjelmointiputka on suomalaisten ohjelmoijien kokoontumispaikka". Eli olen IT-osaamiseeni nähden eksynyt väärään seuraan ja siitä johtuu tahaton huono käytökseni.
t. Taavetti

ErroR++ [18.01.2012 15:16:01]

Et ole ollenkaan väärässä seurassa.

Meitzi [19.01.2012 21:40:09]

Taavetti kirjoitti:

Eli tällaisella allaolevalla pätkällä testasin juuri äsken. Tarkoitus oli testimielessä valita "Ca order inflow.xls" -taulusta AA sarakkeen viisi alinta solua, eli makronauhoituksen ensimmäisen kopioitavan tiedon valinta ("AA265:AA269"). Ei toiminut tuo valinta. Keltaiseksi meni tämä:
Range("AA" & I - 1 & ":AA" & I - 6).Select
Mitähän tein väärin?

Tuo koodi toimii omassa Excel 2010:ssä täysin oikein. (eli saraakkeesta AA kopioi tietoa ja liittää sen toiseen asiakirjaan sinne missä kohdistin siellä sattuu olemaan)

Toki tuo ei oli optimaalisin tapa tehdä asia, mutta se on varmasti sellainen minkä itse ymmärrät. Ja se on tässävaiheessa tärkeämpi kuin se, onko ratkaisu hieno.

Tässä siis juuri se koodi mitä testasin ja toimi.

Sub testi1()
    Windows("Työkirja1.xlsm").Activate
    Dim I As Long
    'Etsitään ensimmäinen tyhjä solu sarakkeesta AA
    For I = 1 To 65000
        If Cells(I, "AA").Value = "" Then Exit For
    Next I
    'Etsitään ylöspäinensimmäinen ei nolla
    For I = I - 1 To 0 Step -1
        If Cells(I, "AA").Value <> 0 Then Exit For
    Next I

    'Valitaan 5 riviä
    Range("AA" & I - 5 & ":AA" & I).Select

    Selection.Copy
    Windows("Työkirja2.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
End Sub

(tuli mieleen että onko mahdollista, että joku office versio ei anna valita negatiivista selectiä, jote muutin sen)

Sivun alkuun

Vastaus

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

Kirjautuminen

Haku

Tehtävät