Piilota tyhjät-makro excelille

Option Explicit

Sub PoistaTyhjätSarakkeet()
Dim Alue As Range
Dim Sarake As Long
On Error GoTo virhe

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set Alue = Range(Columns(1), Columns(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column()))
For Sarake = Alue.Columns.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Alue.Columns(Sarake).EntireColumn) = 0 Then
Alue.Columns(Sarake).EntireColumn.Delete
End If
Next Sarake
virhe:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Keep EXCELing
@Kunde

Kiitokset..Kiitän paljon, mutta jatkokyssärikin tuli mieleen.

Mihin kohtaan kirjoitan komentoa koskevan alueen?

Vaivannäöstä tarjoan virtuaalituopillisen \_/p täytteeksi vaihtoehtoisesti kokista mikäli et bissestä välitä

Set Alue = Range(Columns(1), Columns(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column()))

toi hakee automaattisesti käytössäsi olevan alueen, eli etsii aina taulukosta viimeisen käytössä olevan solun sarakkeen 1-X ;-)

jos haluat kiinteän määrityksen niin sitten esim.
Set Alue = Columns("F:L")

Keep EXCELing
@Kunde

tattista vaan kunpahan sais joskus noi virtuaalit muunneetua todelliseksi niin sitten...

Keep ARCHAing
@Kunde

Ok, nyt ymmärsin mistä kiikastaa excelini kanssa. Kyse ei suinkaan ollut tuon edellisen toimimattomuudesta. Ongelma oli vain siinä, että ylimmillä riveillä oli otsikkotason tietoa, eli en voi määrittää alueeksi esim. kolumneja B:AL kuten oli tarkoitus. Täytyisi saada samantyyppinen, mutta aluetta B8:AL100 koskeva makro. Tällöin kolumni katoaisi, jos siinä ei olisi tietoa noiden otiskkojen lisäksi.

Toteutuksessasi myös pisti silmään se, että turhat kolumnit poistuvat. Olisi varmasti mahdollista palauttaa ne myöhemminkin, mutta paras olisi jos ne ainoastaan piiloutuisivat, seuraavan esimerkin tapaan. Silloinhan ne saa sutjakkaasti palautettua kuten alemmassa myös on tehty. Tavoitteenani on siis alemman kaltainen makro, joka kuitenkin koskisi myös muita kuin vain numeroita.

Sub Hide_EmptyColumns()
'To hide columns with no data in rows 8:100 with columns B-AL

Application.ScreenUpdating = False
With Sheets()
Dim col As Range
For Each col In Range("B8:AL100").Columns
col.EntireColumn.Hidden = _
Application.Sum(col) = 0

Next
End With
Application.ScreenUpdating = True
End Sub
Sub Unhide()
'
' Unhide Macro
' Palauttaa kaikki sarakkeet näkyviin
'
' Keyboard Shortcut: Ctrl n
'
Range("b:al").EntireColumn.Hidden = False
End Sub

lisää kaljaa jemmaan...

nyt hard codena toi alueen siirtymä, mutta se nyt sitten helppo muokata sopivaksi muutujilla

Option Explicit

Sub PoistaTyhjätSarakkeet()
Dim Alue As Range
Dim Sarake As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set Alue = Range("B8:AL100")
For Sarake = Alue.Columns.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Range(Alue(1, 1).Offset(0, Sarake - 1), Alue(93, 1).Offset(0, Sarake - 1))) = 0 Then
Alue.Columns(Sarake).EntireColumn.Hidden = True
End If
Next Sarake
virhe:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Keep EXCELing
@Kunde

Kiitos vielä kerran.

Mistä olisi mahdollisuus lueskella ja oppia tuosta VBA-kielestä (?) lisää. Tuntuu nimittäin tyhmältä vain kysellä valmiita makroja kun saattaisi olla mahdollista oppia niiden kirjoittaminen itse. Nimittäin on minulla vielä muutama pulma.

Voithan toki vastata näihin valmiilla makrollakin mikäli jaksat. Sinulta kun homma tuntuu sujuvan.

1 samanlainen makro kuin viimeisin, mutta nyt piilotettavia ovat rivit (vaakasuoraan), eivät kolumnit.

2 makro, joka kääntäisi valmiin taulukon siten, että x ja y-axelin vaihtaisivat paikkaa. jolloin otsikot ylärivistä siirtyisivätkin vasempaan laitaan a-kolumniin

ja mielellään undo tähän viimeiseen

Niin jälkimmäisellä (nr 2) ajattelin seuraavanlaista. Oletetaan että solu A8:ssä on otsikko (tässä tapauksessa kemiallinen aine). Ylemmät rivit 1-7 sisältävät niin ikään otsikkoja ja näin ollen koko rivi 8 aina B8:sta aina tuonne AL8:aan asti sisältävät sen eri ominaisuuksia.

Nyt olisi kuitenkin tarkoitus kääntää taulukko siten, että tuo solun A8 otsikko siirretään yläriviin (eli siitä tulisi sitten H1), ja sen pitkä lista eri ominaisuuksia olisi järjestyksessä samassa H-kolumnissa (kun ne aiemmin olivat rivillä 8).

Eli siis makro joka ikäänkuin kiertäisi taulukon ympäri. Ja tokihan tähän olisi hyvä myös olla vastaava joka kiertää talukon takaisin alkuperäiseen muotoonsa.

Onko tällainen mahdollista?

moduuliin...

Option Explicit
Dim Alue As Range
Dim a As Variant
Sub Transponoi()
Range("A8").Cut Range("H1")
Set Alue = Range(Range("B8"), Range("B8").End(xlToRight))
a = Range(Range("B8"), Range("B8").End(xlToRight)).Value
Alue = ""
Range("H2", Range("H2").Offset(Alue.Count - 1, 0)) = ""
Range("H2:H" & Alue.Count 1) = Application.WorksheetFunction.Transpose(a)
Application.CutCopyMode = False
End Sub
Sub Transponoi2()
Range("H1").Cut Range("A8")
Set Alue = Range(Range("H2"), Range("H2").End(xlDown))
a = Range(Range("H2"), Range("H2").End(xlDown)).Value
Range("B8", Range("B8").Offset(0, Alue.Count - 1)) = ""
Alue = ""
Range("B8", Range("B8").Offset(0, Alue.Count - 1)) = Application.WorksheetFunction.Transpose(a)
Application.CutCopyMode = False
End Sub

Keep EXCELing
@Kunde

Nyt tuossa näyttäisi vain olevan ongelmana se että se transponoi vain nuo mainitut solut. Kun pitäisi saada koko lakana kääntymään samalla tavalla. Otin vain esimerkiksi nuo mainitut solut, mutta siis koko sheetin kun saisi kääntymään. Näin olisis tarkoitus. Vai onko mahdollista saada tuo aikaiseksi vain muuttamalla rangea? Minä en ainakaan saanut mitään järkevää aikaiseksi sitä kokeilemalla, mutta enhän minä olekaan yhtä excel-taikuri :D

laita mulle email kunde@hotmail.fi

alku ja lopputilanne eri taulukoihinsa

Lähetin nyt tuonne s-postiin. Toivottavasti nyt ymmärrät mitä haen takaa :)

Hei, kiitos nyt vielä kerran paljon. Olet kaltaiselleni suht avuttomalle junnulle suureksi avuksi :D