Keskustelu: Ohjelmointikysymykset: VBA: excel taulukosta turhat rivit pois

help [28.11.2007 12:50:48]

Hei, nyt voi olla taas tyhmä kysymys, mutta on ongelma. Jos joku voisi auttaa tällaisessa: Excel taulukosta pitäisi poistaa turhat rivit eli tässä tapauksessa rivit joissa dataa vain ensimmäisessä sarakkeessa. Yksitellen poistaminen on aika työlästä kun taulukko on aikas suuri.

Hycke [28.11.2007 13:40:46]

Vaikka näin:

Sub RIVIENPOISTO()
   Dim i As Long
   i = 2    'alkaen riviltä 2
   Do Until Cells(i, "A").Value = "" ' loopataan niin kauan kuin sarakkeessa A jotain
        If Cells(i, "B").Value = "" Then 'Jos sarake B tyhjä
                Rows(i).Delete shift:=xlUp   ' niin poistetaan
                i = i - 1
        End If
    i = i + 1
    Loop
End Sub

help [28.11.2007 13:59:09]

Thanks Hycke. Ongelmana on vielä, että ensimmäisillä kolmella rivillä on tekstiä, joten ei ehkä ihan tuollaisenaan toimi, mutta yritänpä soveltaa tuota eteenpäin.. niin ja riveillä mitä ei saisi poistaa on tyhjiäkin soluja mukana. Eli rivi pitäisi poistaa vain jos koko rivillä ei ole muuta kun ekassa sarkeessa arvo.

Osaisitko ehkä auttaa vielä toisessa ongelmassani. Tällaisesta varmaankin saisi jotenkin siistittyä tai tehtyä jonkinlaisen silmukan, mutta en ihan osaa. Tässä yrityksenä oli siis saada taulukosta 2 nimen perässä olevia lukuja nimen perään taulukkoon 1, jossa pitkä lista nimiä... No en ehkä osaa oikein selittää, mutta thanks anyway avusta.

Sub Button2_Click()
Dim areaT1, areaT2, cellT1, cellT2

Sheets("Sheet2").Activate
areaT2 = "B1:B" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT1 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)

For Each cellT1 In Sheets("Sheet1").Range(areaT1)
 For Each cellT2 In Sheets("Sheet2").Range(areaT2)
   If cellT1.Value = cellT2.Value Then
      Cells(cellT1.Row, 3).Value = Sheets("Sheet2").Cells(cellT2.Row, 1).Value
      Cells(cellT1.Row, 4).Value = Sheets("Sheet2").Cells(cellT2.Row, 3).Value
   End If
 Next
Next

Application.ScreenUpdating = True
Dim areaT3, areaT4, cellT3, cellT4

Sheets("Sheet2").Activate
areaT4 = "D1:D" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT3 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)

For Each cellT3 In Sheets("Sheet1").Range(areaT3)
 For Each cellT4 In Sheets("Sheet2").Range(areaT4)
   If cellT3.Value = cellT4.Value Then
      Cells(cellT3.Row, 5).Value = Sheets("Sheet2").Cells(cellT4.Row, 1).Value
      Cells(cellT3.Row, 6).Value = Sheets("Sheet2").Cells(cellT4.Row, 5).Value
   End If
 Next
Next

Application.ScreenUpdating = True
Dim areaT5, areaT6, cellT5, cellT6

Sheets("Sheet2").Activate
areaT6 = "G1:G" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT5 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)

For Each cellT5 In Sheets("Sheet1").Range(areaT5)
 For Each cellT6 In Sheets("Sheet2").Range(areaT6)
   If cellT5.Value = cellT6.Value Then
      Cells(cellT5.Row, 7).Value = Sheets("Sheet2").Cells(cellT6.Row, 1).Value
      Cells(cellT5.Row, 8).Value = Sheets("Sheet2").Cells(cellT6.Row, 8).Value
   End If
 Next
Next

Application.ScreenUpdating = True
Dim areaT7, areaT8, cellT7, cellT8

Sheets("Sheet2").Activate
areaT8 = "I1:I" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT7 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)

For Each cellT7 In Sheets("Sheet1").Range(areaT7)
 For Each cellT8 In Sheets("Sheet2").Range(areaT8)
   If cellT7.Value = cellT8.Value Then
      Cells(cellT7.Row, 9).Value = Sheets("Sheet2").Cells(cellT8.Row, 1).Value
      Cells(cellT7.Row, 10).Value = Sheets("Sheet2").Cells(cellT8.Row, 10).Value
   End If
 Next
Next

Hycke [28.11.2007 16:52:33]

Tuohon 1. kohtaan voisi kokeilla seuraavaa:

Sub RIVIENPOISTO()
    Dim i As Long
    i = 2    'alkaen riviltä 2
    Do Until Cells(i, "A").Value = ""    ' loopataan niin kauan kuin sarakkeessa A jotain
        If Application.WorksheetFunction.Subtotal(3, Range(Cells(i, "B"), Cells(i, "IV"))) = 0 Then 'Jos sarakkeissa B-IV ei ole arvoja
            Rows(i).Delete shift:=xlUp   ' niin poistetaan
            i = i - 1
        End If
    i = i + 1
    Loop
End Sub

2. kohtaan helpotusta?

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 Sub

help [28.11.2007 17:17:07]

Thanksis taas Hycke. Perehdyn noihin ja kokeilen jahka ehdin. Kiva kun joku viitsii auttaa tällaista vasta-alkajaa.

help [28.11.2007 18:42:31]

No niin, taas loppui soveltamisen taito. Hyvin sain sovellettua ja toimimaan tuon rivien poiston, mutta tuo kohta 2 on aikas ongelmallinen ainakin minulle. Mun Sheet 2 sisältää suurinpiirtein tämän näköistä juttua:

1 | aa |45 | | gg | 45 | ...jne 2 | ss |65 | | aa | 65 |.... 3 | ff |76 | | ss | 34 |...

haluaisin että saisin sheet1:lle aina nimen perään 1,2 tai 3 ja sitten luvun
eli

aa | 1 | 45 | 2 | 65 | ... gg | | | 1 | 45 |... ss | 2 | 65 | 3 | 34 |... ff | 3 | 76 | | |...

tähän tyyliin. Saako tästä sotkusta mitään irti?

Vastaus

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

Kirjautuminen

Haku

Tehtävät