Hei kaikki. löysin täältä selailemalla apua ongelmaani. löysin siis tällasen koodin jonka varmaan saisin toimiin omaanki juttuuni, mut sitte on sellanen probleema, että kuinka saa ton jutun hyppään aina tietyn määrän kolumneja yli jos vaikka välissä on aina sellasia, jota ei tarvis eli et se kopiois joka loopilla kolumnista A ja sitten joka kolmannen kolumnin jutut.
Sub Hakua()
Dim i As Long, C As Range, S1 As String, S2 As String
S1 = "Sheet1"
S2 = "Sheet2"
i = 16
Do Until Sheets(S1).Cells(i, "A").Value = ""
With Sheets(S2)
For Each C In .Range(.Cells(1, 1), .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, .Cells.SpecialCells(xlCellTypeLastCell).Column))
If C.Value = Sheets(S1).Cells(i, "A").Value Then
Sheets(S1).Cells(i, C.Column) = .Cells(C.Row, C.Column).Value
Sheets(S1).Cells(i, C.Column + 1) = .Cells(C.Row, C.Column + 1).Value
End If
Next
End With
i = i + 1
Loop
End SubHeippa butterfly!
the viritelmä...
'ThisWorkbook Private Sub Workbook_Open() Sheets(1).CommandButton1.Visible = True End Sub
'Taul1 - Nappi
Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
haku
End Sub
Private Sub haku()
Dim i As Long, solu
i = 1 '[k]haku alkaa riviltä 1[/k]
Application.ScreenUpdating = False
Do Until Sheets(1).Cells(i, "A").Value = ""
With Sheets(2)
For Each solu In .Range("A1:" & _
Replace(.Cells.SpecialCells(xlCellTypeLastCell).Address, "$", ""))
If solu.Value = Sheets(1).Cells(i, "A").Value Then
Select Case .Cells(1, solu.Column).Text
Case "Mortti", "Pertti", "Vertti" ', jne...
'[k]ei tehdä mitään...[/k]
Case Else
Sheets(1).Cells(i, solu.Column) = _
.Cells(solu.Row, solu.Column).Value
End Select
' [k]tai esim.[/k]
' Select Case solu.Column
' Case 1, 4 To 6 'jne...
' '[k]ei tehdä mitään...[/k]
' Case Else
' Sheets(1).Cells(i, solu.Column) = _
' .Cells(solu.Row, solu.Column).Value
' End Select
End If
Next
End With
i = i + 1
Loop
'poista_sarakkeet '[k](tyhjät sarakkeet pois välistä...)[/k]
CommandButton1.Visible = False
Application.ScreenUpdating = True
End Sub
Private Sub poista_sarakkeet()
Dim sarake As String, solu, i As Integer, sarakkeet As String
With Sheets(1)
sarake = _
Replace(Sheets(2).Cells.SpecialCells _
(xlCellTypeLastCell).Address, "$", "")
For i = 1 To Len(sarake)
If IsNumeric(Mid(sarake, i, 1)) Then _
sarake = Left(sarake, i - 1): Exit For
Next i
For Each solu In .Range("A1:" & sarake & "1")
If IsEmpty(solu) Then
Dim xsolu, xsarake() As String
tyhjää = True
xsarake = Split(solu.Address, "$")
Range(xsarake(1) & "1:" & xsarake(1) & _
CStr(Sheets(2).Cells.SpecialCells(xlCellTypeLastCell).Row)) _
.Select
If IsEmpty(RangeSelection) Then
sarakkeet = sarakkeet & xsarake(1) & ":" & xsarake(1) & ","
End If
End If
Next
If Not IsEmpty(sarakkeet) Then
sarakkeet = Left(sarakkeet, Len(sarakkeet) - 1)
.Range(sarakkeet).Select
Selection.Delete
.Range("A1").Select
End If
Erase xsarake
End With
End SubMoikka taas butterfly!
tässä ehkä hieman elegantimpi versio samasta paskasta...
Taul1
OTSIKOT | 1. jutska | 2. jutska | 3. jutska | 4. jutska | 5. jutska | 6. jutska | 7. jutska | 8. jutska | 9. jutska | 10. jutska |
Taul2
OTSIKOT | Maija | Matti | Lasse | Liisa | Vieno | Viljo | 1. jutska | 11 | 21 | 31 | 41 | 51 | 61 | 2. jutska | 12 | 22 | 32 | 42 | 52 | 62 | 3. jutska | 13 | 23 | 33 | 43 | 53 | 63 | 4. jutska | 14 | 24 | 34 | 44 | 54 | 64 | 5. jutska | 15 | 25 | 35 | 45 | 55 | 65 | 6. jutska | 16 | 26 | 36 | 46 | 56 | 66 | 7. jutska | 17 | 27 | 37 | 47 | 57 | 67 | 8. jutska | 18 | 28 | 38 | 48 | 58 | 68 | 9. jutska | 19 | 29 | 39 | 49 | 59 | 69 | 10. jutska | 20 | 30 | 40 | 50 | 60 | 70 |
VB-koodi
'ThisWorkbook Private Sub Workbook_SheetBeforeDoubleClick(ByVal _ Sh As Object, ByVal Target As Range, Cancel As Boolean) If Not UserForm1.Visible Then UserForm1.Show End Sub
'UserForm1
'[k]formille: ListBoxi & nappi
'käyttö: tuplaklikkaa taulua & anna palaa...[/k]
Dim solu, alue
Private Sub UserForm_Initialize()
Me.Caption = "Tuo valitut..."
Me.Width = 151: Me.Height = 151
ListBox1.Width = 130: ListBox1.Height = 80
ListBox1.Top = 10: ListBox1.Left = _
(Me.Width - ListBox1.Width) / 2 - 3
CommandButton1.Width = 50
CommandButton1.Height = 18
CommandButton1.Left = _
(Me.Width - CommandButton1.Width) / 2 - 3
CommandButton1.Top = Me.Height _
- (CommandButton1.Height * 3.3)
End Sub
Private Sub UserForm_Activate()
Dim pText As Boolean
Application.ScreenUpdating = False
ListBox1.Clear
Sheets(2).Activate
alue = "A1:" & _
Replace(Cells.SpecialCells( _
xlCellTypeLastCell).Address, "$", "")
Dim splitti() As String
splitti = Split(alue, ":")
For i = 1 To Len(splitti(1))
If IsNumeric(Mid(splitti(1), i, 1)) Then
splitti(1) = Left(splitti(1), i - 1): Exit For
End If
Next i
For Each solu In Range("A1:" & splitti(1) & "1")
pText = True
For i = 1 To Len(solu.Text)
If IsNumeric(Mid(solu.Value, i, 1)) Or _
solu.Text = "OTSIKOT" Then
pText = False: Exit For
End If
Next i
If pText Then _
ListBox1.AddItem solu.Value
Next
If ListBox1.ListCount > 0 Then
ListBox1.ListStyle = fmListStyleOption
ListBox1.MultiSelect = fmMultiSelectMulti
For i = 2 To Sheets(2).Cells. _
SpecialCells(xlCellTypeLastCell).Column
For j = 0 To ListBox1.ListCount - 1
If Sheets(1).Cells(1, i).Value = _
ListBox1.List(j) Then
ListBox1.Selected(j) = True
End If
Next j
Next i
End If
Sheets(1).Activate
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
haku
poista_sarakkeet
Application.ScreenUpdating = True
End Sub
Sub haku()
Dim valinta As Boolean
Sheets(1).Activate
Range("B1:" & Sheets(2).Cells. _
SpecialCells(xlCellTypeLastCell).Address).Select
Selection.Clear
For Each solu In Sheets(2).Range(alue)
If Cells(solu.Row, 1).Value = _
Sheets(2).Cells(solu.Row, 1).Value Then
For i = 0 To ListBox1.ListCount - 1
valinta = False
If ListBox1.List(i) = Sheets(2).Cells(1, solu.Column).Text _
And ListBox1.Selected(i) Then
valinta = True: Exit For
End If
Next i
Select Case valinta
Case False
'[k]ei tapahtumaa...[/k]
Case Else
Cells(solu.Row, solu.Column).Value = solu.Value
End Select
End If
Next
End Sub
Sub poista_sarakkeet()
Dim sarake As String, solu, sarakkeet As String
With Sheets(1)
sarake = _
Replace(Sheets(2).Cells.SpecialCells(xlCellTypeLastCell).Address, "$", "")
For i = 1 To Len(sarake)
If IsNumeric(Mid(sarake, i, 1)) Then _
sarake = Left(sarake, i - 1): Exit For
Next i
For Each solu In .Range("B1:" & sarake & "1")
If IsEmpty(solu) Then
Dim xsolu, xSarake() As String
tyhjää = True
xSarake = Split(solu.Address, "$")
Range(xSarake(1) & "1:" & xSarake(1) & _
CStr(Sheets(2).Cells.SpecialCells(xlCellTypeLastCell).Row)) _
.Select
If IsEmpty(RangeSelection) Then
sarakkeet = sarakkeet & xSarake(1) & ":" & xSarake(1) & ","
End If
End If
Next
If Len(sarakkeet) > 1 Then
sarakkeet = Left(sarakkeet, Len(sarakkeet) - 1)
.Range(sarakkeet).Select
Selection.Delete
Cells(1, 1).Activate
End If
End With
Erase xSarake
End SubKiitos Nea. Kokeilen ja yritän ymmärtää tuota jutskaa. Katsotaan saanko toimimaan.
Hei taas. Katselin tuota koodia ja sain sen tekemään kummia. Ehkä täytyy selittää ongelmani paremmin. Yritän tehdä apuvälineeks (huonolla menestyksellä siis, enemmän hommaa tässä on kun käsin kirjoittamisessa, mutta mielenkiintoista) sellasta taulukko systeemiä mihin saatais lasten urheilu suoritukset järjesteltyä.
Taulukko1
Juoksu1 pituus1: pallonheitto1 juoksu2 Nimi: | sijoitus:| aika | sijoitus | pituus | sijoitus: | pituus | sijoitus | Anni | Kaisu | Venla | Riikka | Annika | Ronja | Ville | Roni | Samu | Erik | Juuso | Viljami |
Taulukkoon 2 olen laittanu aina esimerkiks tähän malliin
juoksu1 pituus: 1 | Venla | 1,34,5 | Ville | 2 | Juuso | 1,35,2 | Ronja 3 | Anni | 1,36,1 | Roni 4 | Roni | | Samu 5 | Samu | 1,40,2 | 6 | Annika 7 | Ronja 8 | Ville 9 | Viljami 10| Erik 11| Kaisu 12| Riikka
Ajattelin vaan että tarviiko kirjoittaa aina tuo sijoitus tuonne väliin vai saako sen aina tuosta kolumnista A ja jos ei ole ollut paikalla ja suorituksena on tyhjä niin että vaan hyppäis seuraavaan ja voiko juoksu ajan ja pituus sijoituksen väliin tulla tyhjä sarake että on helpompaa pitää kirjaa.
Ehkä tämä meni hieman yli osaamiseni, mutta kiitos avusta kuitenkin.
Heippa taas butterfly!
Hieno homma, että lähdit välittömästi tutkimaan mitä tapahtuu jos...
sit kysymykseesi: mikä/mitkä tahansa vertailu arvo/t on haettavissa minkä tahansa taulun mistä tahansa solusta/soluista eli mitään tietoa ei tarvitse välttämättä tuplata (jos tuplaus helpottaa hetkellisesti niin sen ei tarvitse välttämättä näkyä taulussa jne.)
Tärkein pointti on kuitenkin, että tutkit mitä tapahtuu ja selvität miksi...
VBE:n helppiä kannattaa tutkia ja jos asia ei aukea helpin tiedoilla niin kannattaa metsästää tietoa Netistä käyttämällä helpissä esiintyviä termejä hakusanoina - taatusti löytyy hyviä esimerkkejä joka lähtöön...
-Nea
Kiitosta taas Nea!
Pitkällisen pohdinnan jälkeen sain aikaiseksi toimivan jutun, joka vielä osaa hakea sarakkeesta A sijoituksen. En kylläkään saanut toimimaan sitä että tyhjät sarakkeet saisi pois. Yritin tuota sinun kirjoittamaa koodikin, mutta se ilmoitti jonkun virheen tuossa lopussa .Range(sarakkeet).Select kohdalla. Täytyy siis pohtia lisää.
Hei. Tämä voi taas olla hieman yksinkertainen kysymys, mutta palatakseni ylläolevaan ongelmaani niin, kuinka voisin saada Taulukosta 2 haluamani arvot haluamaani kohtaan. Nyt saan se vaan menemään oikealle riville taulukkoon1, mutta samaan kohtaan, siis sarkkeeseen, kun ne ovat taulukossa 2. Siis jos arvo on ollut taulukossa 2 sarakkeessa D niin se menee sarakkeeseen D taulukossa 1:kin, vaikka haluaisin sen esimerkiksi sarakkeeseen C. Onkohan tähän joku kikka tai siis voiko sen jotenkin määritellä, kun näin aloittelijana en löydä ratkaisua.
Dim taulukko(3, 1)
Dim i As Integer
Dim sisältö As String
For i = 1 To 3
Select Case i
Case 1
sisältö = "moro "
Case 2
sisältö = "Vaan "
Case 3
sisältö = "kaikille"
End Select
taulukko(i, 0) = sisältö
Next
For i = 1 To 3
Select Case i
Case 1
sisältö = "ja "
Case 2
sisältö = "hyvää "
Case 3
sisältö = "joulua "
End Select
taulukko(i, 1) = sisältö
Next
TextBox1.Text = taulukko(2, 1) & taulukko(3, 1) & taulukko(1, 1) & taulukko(1, 0) & taulukko(3, 0)
'jos vaihdat vaikka tyyliin taulukko(1,1) = taulukko(3,0) niin teksti muuttuu siten et, että "ja " muuttuu sanaksi "kaikille " taulukon kohdassa taulukko(1,1)
'eli tuo taulukko(3,0) kopioituu taulukon kohtaan taulukko(1,1)
End SubHei taas. Entäs jos kun taulukot voivat paisua aika suuriksikin, eikö silloin ole aikas työlästä kirjoittaa tuollaista vai ymmärsinkö koodin oikein? Voi olla etten nyt ihan ymmärtänyt.
tuossa nyt oli vain esimerkki miten voidaan kopioida taulukon kohdasta x taulukon kohtaan x. noissa for nexteissä vaan loin sisältöä niihin, ei se ollut oleellista.
tuo alin kommentti oli se tärkein pointti.
jos haluat että taulukon kohta taulukko(6) sisältämä data löytyykin kohdasta taulukko(5) niin sitten kopioit sen sinne.
taulukko(5) = taulukko(6)
muista vaan tallettaa tuon (5):sen sisältämä data jonnekkin muualle sitä ennen jos tarvitset sitä.
eli jos haluat taulukko(6,2) (6 = rivi ja 2 on sarake. riviltä 6 sarake 2) siirtää datan taulukkoon taulukko(3,5) niin se on vain
taulukko(3,5) = taulukko(6,2)
yleensä ottaen kun kerran alusta asti teet softan, niin järjestele datan vienti taulukkoon siten ettei jälkikäteen ole tarpeen vaihdella paikkoja taulukossa.
ja lukea kerran voi missä järjestyksessä tahansa.
textbox1.text = taulukko(3,1) & " " & taulukko(5,2) & " " & Taulukko(4,3)
Heippa taas butterfly!
tässä olisi taas pikku viritelmä...
Testitaulut - testaa ensin, muuttele vasta sitten...
Taul1:
1. jutska 2. jutska 3. jutska 4. jutska 5. jutska 6. jutska 7. jutska 8. jutska 9. jutska 10. jutska
Taul2:
OTSIKOT Maija Matti Lasse Liisa Vieno Viljo 1. jutska 11 21 31 41 51 61 2. jutska 12 22 32 42 52 62 3. jutska 13 23 33 43 53 63 4. jutska 14 24 34 44 54 64 5. jutska 15 25 35 45 55 65 6. jutska 16 26 36 46 56 66 7. jutska 17 27 37 47 57 67 8. jutska 18 28 38 48 58 68 9. jutska 19 29 39 49 59 69 10. jutska 20 30 40 50 60 70
Taul3:
OTSIKOT Paavo Päivi Orvokki Ossi Veikko Viola 1. jutska 71 81 91 101 111 121 2. jutska 72 82 92 102 112 122 3. jutska 73 83 93 103 113 123 4. jutska 74 84 94 104 114 124 5. jutska 75 85 95 105 115 125 6. jutska 76 86 96 106 116 126 7. jutska 77 87 97 107 117 127 8. jutska 78 88 98 108 118 128 9. jutska 79 89 99 109 119 129 10. jutska 80 90 100 110 120 130
ThisWorkbook:
'[k]käyttö: tuplaklikkaa tulua & anna palaa...[/k] Private Sub Workbook_SheetBeforeDoubleClick(ByVal _ Sh As Object, ByVal Target As Range, Cancel As Boolean) If Not UserForm1.Visible Then UserForm1.Show End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Saved = True End Sub Private Sub Workbook_BeforeSave( _ ByVal SaveAsUI As Boolean, Cancel As Boolean) 'If ActiveWorkbook.Name = "theJutska.xls" Then Cancel = True '[k]tämä pikku kikka toimii siten, että kun olet tyytyväinen koodisi 'niin tallennat työkirjan esim. nimellä XtheJutska.xls -> poistat 'nämä rivit lukuunottamatta ylintä, josta poistat vain hipsun 'edestä, tallennat työkirjan uudestaan, suljet työkirjan & muutat 'tiedoston nimeksi theJutska.xls eli poistat X:n...[/k] End Sub
UserForm1:
'Generaaleihin
Dim solu, alue, indeksi As Integer
Private Sub UserForm_Initialize()
'formille: CoboBoxi, ListBoxi, Label & pari nappia
Me.Caption = ""
Me.Width = 151: Me.Height = 191
Me.SpecialEffect = fmSpecialEffectRaised
Me.StartUpPosition = 1
ComboBox1.Width = 130: ComboBox1.Top = 8
ComboBox1.Left = _
(Me.Width - ListBox1.Width) / 2 - 3
ListBox1.Width = 130: ListBox1.Height = 80
ListBox1.Top = 35: ListBox1.Left = _
(Me.Width - ListBox1.Width) / 2 - 3
CommandButton1.Caption = ""
CommandButton1.Width = 12
CommandButton1.Height = 12
CommandButton1.ForeColor = &H80000009
CommandButton1.Left = ListBox1.Left
CommandButton1.Top = Me.Height
Label1.Caption = ""
Label1.AutoSize = False
Label1.Left = ListBox1.Left
Label1.Height = CommandButton1.Height
Label1.Top = ListBox1.Top + _
ListBox1.Height - (CommandButton1.Height / 2)
Label1.SpecialEffect = fmSpecialEffectBump
CommandButton2.Caption = "OK"
CommandButton2.Width = 50
CommandButton2.Height = 18
CommandButton2.Left = _
(Me.Width - CommandButton2.Width) / 2 - 3
CommandButton2.Top = Me.Height _
- (CommandButton2.Height * 3.3)
End Sub
Private Sub UserForm_Activate()
ComboBox1.Clear
Dim taul As Worksheet
If ActiveWorkbook.Worksheets.Count > 1 Then
For Each taul In ActiveWorkbook.Worksheets
With taul
If .Index > 1 Then ComboBox1.AddItem .Name
End With
Next
ComboBox1.ListIndex = 0
End If
End Sub
Private Sub ComboBox1_Change()
indeksi = Sheets(ComboBox1.Text).Index: jutskaInit
If ListBox1.ListCount = 0 Then
CommandButton2.Enabled = False
Else: CommandButton2.Enabled = True
End If
End Sub
Private Sub CommandButton1_Click()
Select Case Label1.Caption
Case " valitse kaikki"
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = True
Next i
Label1.Caption = " poista valinnat"
Label1.Width = Len(Label1.Caption) * 3.75
Exit Sub
Case Else
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next i
Label1.Caption = " valitse kaikki"
Label1.Width = Len(Label1.Caption) * 3.75
End Select
End Sub
Private Sub CommandButton1_Enter()
Label1.BorderStyle = fmBorderStyleSingle
Label1.BackColor = &HFFC0C0
End Sub
Private Sub CommandButton1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Label1.BorderStyle = fmBorderStyleNone
Label1.SpecialEffect = fmSpecialEffectBump
Label1.BackColor = &H8000000F
End Sub
Private Sub Label1_Click()
CommandButton1.SetFocus
CommandButton1_Click
End Sub
Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 32 Then tsekkaaValinnat
End Sub
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
tsekkaaValinnat
End Sub
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
haku
poista_sarakkeet
Me.Caption = "Tiendosiirto valmis"
Application.ScreenUpdating = True
End Sub
Sub jutskaInit()
Application.ScreenUpdating = False
ListBox1.Clear
Dim pText As Boolean
If ActiveSheet.Index = 1 Then
Me.Caption = "Tuo tiedot..."
Else
Me.Caption = "Siirrä tiedot..."
End If
CommandButton1.Visible = False
Label1.Visible = False
Application.ScreenUpdating = False
Sheets(indeksi).Activate
alue = "A1:" & _
Replace(Cells.SpecialCells( _
xlCellTypeLastCell).Address, "$", "")
Dim splitti() As String
splitti = Split(alue, ":")
For i = 1 To Len(splitti(1))
If IsNumeric(Mid(splitti(1), i, 1)) Then
splitti(1) = Left(splitti(1), i - 1): Exit For
End If
Next i
For Each solu In Range("B1:" & splitti(1) & "1")
pText = True
For i = 1 To Len(solu.Text)
If IsNumeric(Mid(solu.Value, i, 1)) Or _
solu.Text = "" Then
pText = False: Exit For
End If
Next i
If pText Then _
If Not solu.Value = "" Then _
ListBox1.AddItem solu.Value
Next
If ListBox1.ListCount > 0 Then
ListBox1.ListStyle = fmListStyleOption
ListBox1.MultiSelect = fmMultiSelectMulti
For i = 2 To Sheets(indeksi).Cells. _
SpecialCells(xlCellTypeLastCell).Column
For j = 0 To ListBox1.ListCount - 1
If Sheets(1).Cells(1, i).Value = _
ListBox1.List(j) Then
ListBox1.Selected(j) = True
End If
Next j
Next i
CommandButton1.Visible = True
Label1.Visible = True
tsekkaaValinnat
End If
Sheets(1).Activate
Application.ScreenUpdating = True
End Sub
Sub haku()
Dim valinta As Boolean
Sheets(1).Activate
Range("B1:" & Sheets(indeksi).Cells. _
SpecialCells(xlCellTypeLastCell).Address).Select
Selection.Clear
For Each solu In Sheets(indeksi).Range(alue)
If Cells(solu.Row, 1).Value = _
Sheets(indeksi).Cells(solu.Row, 1).Value Then
For i = 0 To ListBox1.ListCount - 1
valinta = False
If ListBox1.List(i) = Sheets(indeksi).Cells(1, solu.Column).Text _
And ListBox1.Selected(i) Then
valinta = True: Exit For
End If
Next i
Select Case valinta
Case False
'[k]ei tapahtumaa...[/k]
Case Else
Cells(solu.Row, solu.Column).Value = solu.Value
End Select
End If
Next
End Sub
Sub poista_sarakkeet()
Dim sarake As String, solu, sarakkeet As String
With Sheets(1)
sarake = _
Replace(Sheets(indeksi).Cells.SpecialCells(xlCellTypeLastCell).Address, "$", "")
For i = 1 To Len(sarake)
If IsNumeric(Mid(sarake, i, 1)) Then _
sarake = Left(sarake, i - 1): Exit For
Next i
For Each solu In .Range("B1:" & sarake & "1")
If IsEmpty(solu) Then
Dim xsolu, xSarake() As String
tyhjää = True
xSarake = Split(solu.Address, "$")
Range(xSarake(1) & "1:" & xSarake(1) & _
CStr(Sheets(indeksi).Cells.SpecialCells(xlCellTypeLastCell).Row)) _
.Select
If IsEmpty(RangeSelection) Then
sarakkeet = sarakkeet & xSarake(1) & ":" & xSarake(1) & ","
End If
End If
Next
If Len(sarakkeet) > 1 Then
sarakkeet = Left(sarakkeet, Len(sarakkeet) - 1)
.Range(sarakkeet).Select
Selection.Delete
Cells(1, 1).Activate
End If
End With
Erase xSarake
End Sub
Sub tsekkaaValinnat()
Dim laskuri As Integer
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
laskuri = laskuri + 1
End If
Next
If laskuri = ListBox1.ListCount Then
Label1.Caption = " poista valinnat"
Else: Label1.Caption = " valitse kaikki"
End If
Label1.Width = Len(Label1.Caption) * 3.75
End SubHei Nea ja vau, nyt on niin jännittävän näköinen juttu, että tämä vaatii hieman aikaa, että tällainen asiasta vähän ymmärtävä pääsee jyvälle. Kiitos taas kuitenkin avusta, yritän katsella ja ymmärtää ja sulatella tätä juttua.
Aihe on jo aika vanha, joten et voi enää vastata siihen.