Tehoa taulukon käsittelyyn

1x2

Hei. Olen kopsannut netistä taulukoita välilehdille ja niistä koonnut yhtenäisen taulukon. Mun osaamisella jo kuudella välilehdellä olevien taulukoiden kasaamisessa menee reilut 8,5 min. Tohon nopeuteen mä pyytäsin apuu, niin tulis homma mielekkäämmäks.
Tos olis yhen kopioidun (Ottelut) taulukon osote, jos siit on apuu. Ylärivin nimet oon muuttanu samanlaiseks kuin vasemmas laidas on.
https://fi.wikipedia.org/wiki/Englannin_Valioliigan_kausi_2015–2016

Sub Lue_Data()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim r1 As Integer
Dim r2 As Integer
Dim solu As Range
Application.ScreenUpdating = False
ActiveSheet.Unprotect
r1 = 9: r2 = 9
For i = 6 To Sheets.Count
For j = 2 To 21
For k = 2 To 21
Range("A" & r1) = Sheets(i).Range("A" & j)
If Range("A" & r1) <> Sheets(i).Range("A" & k) Then
Range("B" & r1) = Sheets(i).Range("A" & k)
r1 = r1 1
Else
Range("A" & r1) = ""
End If
Next
For Each solu In Sheets(i).Range("B" & j & ":U" & j)
If solu <> "" Then
Range("C" & r2) = solu
Range("F" & r2) = Sheets(i).Name
r2 = r2 1
End If
Next
Next
Next
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub

4

386

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • lisäätietoja

      Tuleeko taulukosta kuitenkin sellainen kuin haluat?
      Esim. tämä rivi kirjoittaa samaan soluun 20 kertaa:
      Range("A" & r1) = Sheets(i).Range("A" & j)

    • 1x2

      Just sellanen kun pitää. Siis se toimii ja on käytössä, mutta niin pirullisen hidas,. Eli A-sarakkeeseen 19 riviä allekkain kotijoukkue (sama) ja B-sarakkeeseen vierasjoukkueet, sekä C-sarakkeeseen tulos. Sit seuraavat "joukkueet" noitten alle samalla systeemillä. Esim. tos kuuden pelikauden tilastossa on vajaat 2300 rivii tuloksii

    • Kundepuu

      Sub Fiksattu()
      Dim Tilasto As Worksheet
      Dim Alue As Variant
      Dim Alue2 As Variant
      Dim Solu As Range
      Dim j As Long
      Dim k As Long
      Dim vika As Long

      Application.ScreenUpdating = False
      ActiveSheet.Unprotect
      Set Tilasto = ActiveSheet
      Tilasto.Range("A:F") = ""
      k = 0
      For i = 6 To Sheets.Count
      For Each Solu In Worksheets(i).Range("A2:A21")
      vika = Tilasto.Cells(Rows.Count, "A").End(xlUp).Row 1
      If vika < 9 Then vika = 9
      Range(Cells(vika, "A"), Cells(vika 19, "A")).Value = Solu
      Range(Cells(vika, "F"), Cells(vika 19, "F")).Value = Worksheets(i).Name
      Next Solu
      For j = 1 To 20
      Alue = Worksheets(i).Range("B1:U1").Value
      Tilasto.Range("B9").Offset(k, 0).Resize(20, 1) = Application.WorksheetFunction.Transpose(Alue)
      Alue2 = Worksheets(i).Range("B1:U1").Offset(j).Value
      Tilasto.Range("C9").Offset(k, 0).Resize(20, 1) = Application.WorksheetFunction.Transpose(Alue2)
      k = k 20
      Next
      Next
      vika = Tilasto.Cells(Rows.Count, "A").End(xlUp).Row 1
      Tilasto.Range("C9:C" & vika).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      ActiveSheet.Protect
      Application.ScreenUpdating = True
      End Sub


      Keep EXCELing
      @Kunde

    • 1x2

      Kiitti koodista, toimii hienosti. En vain älynny kertoo kaikkee.
      Laitan toiveet, jos sais nää muutettuu.

      Rivit 1-8 säilys muuttumattona (sisältää otsikoita ja muuta tekstii, nyt tyhjenee)
      Sarakkeet A-F riviltä 9 lähtien säilyttäs kohteen muotoilun
      Sarakkeissa D-E olevat kaavat säilyisivät, nyt häippäsee

      Saisko jonkun tämmösen rivin C-sarakkeen välimerkin mahdollista muuttamista varten.
      Ottasin sen tarvittaessa käyttöön (ollut yhdellä sivulla erilainen merkki).
      Selection.Replace What:="–", Replacement:="-", SearchOrder:=xlByColumns, MatchCase:=True

    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Me työeläkeläiset äänestämme SDP:tä

      SDP on luonut koko työeläkejärjestelmän, jonka hedelmistä saamme nyt nauttia. Kansaneläkelaitos on Maalaisliiton tekele,
      Maailman menoa
      207
      5260

    2. Eikö tunnukin kamalalta, kun en

      anna periksi vaikka parhaasi olet tehnyt antaaksesi täystyrmäyksen? Ja kyllähän minä monta iskua olen saanut ja maannut
      Ikävä
      81
      3726

    3. SDP on selvästi paras valinta äänestyskopissa

      Puolueella on arvomaailma kohdallaan, sillä on hyvä CV itsenäisen Suomen historiassa vastuunkantajana ja hyvinvointivalt
      Maailman menoa
      67
      3613

    4. Persut on Suomen mamutuspuolue nro 1.

      Heti ensimmäisenä persuvuonna 2015 maahantoivat Suomeen 35 tuhatta kunniavierastaan. Tuoreimpana persuvuonna 2025 pers
      Maailman menoa
      22
      3558

    5. SDP:n johto pesi kätensä häirintäkohusta

      "Suurimman oppositiopuolue SDP:n johto olisi todennäköisimmin halunnut vaieta puolueen ympärillä velloneen häirintäkohun
      Maailman menoa
      44
      3170

    6. SDP on vastuunkantaja, ja siksi suosituin kansan keskuudessa

      Kiusaamiseenkin SDP puuttuu heti sellaisen tultua ilmi. Esimerkiksi persut lakaisevat nämä maton alle ja pahentavat site
      Maailman menoa
      34
      2468

    7. Kenen juontajan pitäisi voittaa tänään Kultainen Venla? Ehdolla Pimiä, Holma ja Vaaherkumpu

      Kultainen Venla gaalassa jaetaan tänään tv-alan palkintoja. Yksi suosituimmista kategorioista on Juontaja. Vappu Pimiä
      Suomalaiset julkkikset
      106
      2380

    8. SDP:n selitykset ontuu pahasti - "On käsitelty heti, mutta kukaan ei tiedä"

      Kokoomuslaiset pistää taas demareita nippuun. Tuppuraisen mukaan mukaan SDP:n useat ahdistelutapaukset on käsitelty het
      Maailman menoa
      41
      2356

    9. Oletko nainen turhautunut, kun en tule juttelemaan siellä?

      Haluaisin tottakai tulla. Älä käsitä väärin. Ehkä ensi kerralla?
      Ikävä
      31
      2204

    10. Antti Lindtman: "Ainahan kaikenlaisia huhuja liikkuu"

      Näin hän siis vastaa SDP:n häirintäkohuun, väistelee vastuutaan Juttuhan on niin, että Lindtman ja Tuppurainen on tasan
      Maailman menoa
      76
      2150
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt