Voisiko joku kirjoittaa makron joka piilottaa tyhjät kolumnit excel-taulukossa. Osasin jonkin verran, mutta kun minulta katoaa myös kolumnit joissa on sanoja, ja vain numeroita sisältävät kolumnit jäävät.
Eli tarvitsisin makron joka piilottaa kaikki tyhjät kolumnit, mutta jättää ne joissa on dataa, mitä tahansa dataa siis, esim sanoja tai numeroita.
Vaivautuisiko joku? :)
Piilota tyhjät-makro excelille
14
304
Vastaukset
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- kesätyöläinen
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- kesätyöläinen
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- kesätyöläinen
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 viimeiseenjälkimmäistä kyssäriä en ymmärtänyt?
muuta alue sopivaksi
moduuliin...
Option Explicit
Sub PoistaTyhjätRivit()
Dim Alue As Range
Dim Rivi As Long
Dim Sarake1 As Long
Dim Sarake2 As Long
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set Alue = Range("B8:M40")
Sarake1 = Alue(1, 1).Column
Sarake2 = Alue(1, 1).Offset(0, Alue.Columns.Count - 1).Column
For Rivi = Alue(Alue.Count).Row To Alue.Cells(1, 1).Row Step -1
If ALueTyhjä(Range(Cells(Rivi, Sarake1), Cells(Rivi, Sarake2))) Then
Range("A" & Rivi).EntireRow.Hidden = True
End If
Next Rivi
virhe:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Function ALueTyhjä(Alue As Range) As Boolean
ALueTyhjä = (WorksheetFunction.CountA(Alue) = 0)
End Function
Sub resetoi()
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Keep EXCELing
@Kunde
- kesätyöläinen
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- kesätyöläinen
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 [email protected]
alku ja lopputilanne eri taulukoihinsa- kesät
Lähetin nyt tuonne s-postiin. Toivottavasti nyt ymmärrät mitä haen takaa :)
mallihan oli selkeä...
transponoi koko taulukon
moduuliin...
Option Explicit
Sub Transponoi()
Dim i As Long
Dim vikarivi As Long
Dim vikasarake As Long
On Error Resume Next
Application.ScreenUpdating = False
vikarivi = Range("A65536").End(xlUp).Row
vikasarake = Range("A1").End(xlToRight).Column
For i = 1 To vikarivi
Range("A" & i, Range("A" & i).Offset(0, vikasarake - 1)).Copy
Range("A" & vikarivi 1).Offset(0, i - 1).PasteSpecial xlValues, Transpose:=True
Next i
Rows("1:" & vikarivi).Delete
Application.CutCopyMode = False
Range("A1").Activate
Application.ScreenUpdating = True
End Sub
Keep EXCELing
@Kunde
- kesäty
Hei, kiitos nyt vielä kerran paljon. Olet kaltaiselleni suht avuttomalle junnulle suureksi avuksi :D
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
- 1592356
Kun viimeksi kohtasitte/näitte
Mitä olitte tekemässä? Millainen ympäristö oli? Löydetään toisemme...1361895Olet kyllä vaarallisen himokas
Luova, kaunis, määrätietoinen, pervo, mielenkiintoinen, kovanaama, naisellinen ja erikoinen.1061715- 741364
Anna vielä vähän vihreää valoa
Teen sitten siirtoni, nainen. Tiedän, että olet jo varovaisesti yrittänyt lähestyä, mutta siitä on jo aikaa. Jos tunnet211337- 721306
- 2281086
- 71874
Miksi homous puhuttaa konservatiiveja vuodesta toiseen?
Kysymykseen on vastattukin Kansanlähetyksen osalta: "Miksi sukupuoleen ja seksuaalisuuteen liittyvät asiat ovat konserv212823- 46790