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

359

Ää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. Miksi persuilla ei ole firmoja?

      Kuten vasemmisstolaisilla, esim. Sannalla MA\PI. Eikö ole aika erikoista?
      Maailman menoa
      82
      7066

    2. Persut hommasivat Suomeen 35 000 pientä lasta v. 2015

      Onko Riikka Purra nyt tavoittelemassa tätä samaa historiallista persujen utopiaa? Purram kaksinaamaisessa pelissä vaadit
      Maailman menoa
      26
      7033

    3. Purran tuhoja tuskin saadaan koskaan korjatuksikaan

      Purra on aiheuttanut Suomen taloudelle karmaisevat tuhot. Sen lisäksi Purra on ajanut myös suuren osan Suomen kansasta k
      Maailman menoa
      106
      6143

    4. Persujen kaksoisstandardit: Räsäsen uhkailu paha, Virran uhkailu hyvä

      Tässä taas nähdään kuinka kaksinaamaista porukkaa persut ovat. Mitäs persut tähän?
      Maailman menoa
      45
      5394

    5. Miksette persut irtisanoudu Kirkin lausunnoista?

      Kirkhän muun muassa vaati raiskattuja naisia pidättäytymään abortista ja vaimoja alistumaan aviomiestensä tahtoon. Mik
      Maailman menoa
      84
      5218

    6. Demarikultin uhri kertoo

      Demarikultin uhri kertoo: “En saanut mennä edes suihkuun ilman lupaa” – Seksuaalisen hyväksikäytön uhri kertoo vuosistaa
      Maailman menoa
      60
      5163

    7. Miksi vasemmistolaiset eivät omista yhtään firmaa?

      Vasemmistolaiset eivät omista yhtään firmaa joka työllistäisi ihmisiä. Miksi? No siksi, että jos vasemmistolainen perus
      Maailman menoa
      40
      5088

    8. Sanna valittiin Euroopan huonoimmaksi pääministeriksi

      Sannan kaudella Suomi oli ainut maa missä bkt laski. Kannattaa huomata, että luvut valitsi Sannan huonoimmaksi. Ihmiset
      Maailman menoa
      27
      4575

    9. Purran vuoro kiihoittua Lepomäen sääristä

      "Ulkoministeri Elina sanoo, ettei muuta pukeutumistaan sen mukaan, kenet tapaa, ja että hän ei suostuisi peittämään kasv
      Maailman menoa
      16
      3417

    10. Vasemmistolaiset paskat eivät nousseet seisomaan kun Akaan kaupunginvaltuusto

      vietti hiljaisen hetken Charlie Kirkin muistoksi https://www.aamulehti.fi/uutiset/art-2000011523016.html
      Maailman menoa
      300
      3360
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt