Hei,
Tiedoston Taul1 sisältää X riviä tietoa, jokaisella rivillä tietoa on soluissa A:K. Tiedot pitäisi kopioda samaisen tiedoston välilehteen Taul2 sarakkeeseen B niin että yhden rivin tiedot ovat soluissa B1:B11, toisen rivin tiedot soluissa B12:B23, kolmannen rivin tiedot soluissa B24:B35 ja niin edelleen.
Onnistuuko makrolla tuo jotenkin?
Solun transponointi sarakkeeseen
21
1988
Vastaukset
- meillä
>...makrolla tuo jotenkin?
En tiedä Excelistä mutta OpenOfficen Calcilla tuo hoituu ihan functiolla TRANSPOSE.
http://www.openofficetips.com/blog/archives/2004/10/array_formulas.html- JariM
Tuo ei skulaa ja sama transponointi onnistuu kyllä Excelissäkin, mutta ongelmaksi tässä muodostuu se, että makron pitäisi transponoida tiedot yhteen sarakkeeseen. Antamassasi esimerkissähän on aivan normaali transponointi, jolloin tiedot kopioituvat kolmelta riviltä kolmeen sarakkeeseen. Tarvitsisin siis jonkin VBA-koodin millä vaikka 250 rivistä saataisiin tiedot kopioitua yhdelle sarakkeelle.
- niin.
JariM kirjoitti:
Tuo ei skulaa ja sama transponointi onnistuu kyllä Excelissäkin, mutta ongelmaksi tässä muodostuu se, että makron pitäisi transponoida tiedot yhteen sarakkeeseen. Antamassasi esimerkissähän on aivan normaali transponointi, jolloin tiedot kopioituvat kolmelta riviltä kolmeen sarakkeeseen. Tarvitsisin siis jonkin VBA-koodin millä vaikka 250 rivistä saataisiin tiedot kopioitua yhdelle sarakkeelle.
Sorry, luin kysymyksesi hätäisesti. :(
- rpo
saat yhdistettyä tietosi yhteen sarakkeeseen.
Sub YhdistäTiedot()
Dim tArr As Variant
Dim i As Integer
Dim Kohderivi As Integer
tArr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K")
Sheets("Taul1").Select
Kohderivi = 1
For i = 0 To 10
If i > 0 Then Kohderivi = 2
Range(tArr(i) & "1:" & tArr(i) & Range(tArr(i) & "65536").End(xlUp).Row).Copy _
Destination:=Worksheets("Taul2").Cells(Rows.Count, "B").End(xlUp)(Kohderivi)
Next i
End Sub- JariM
Tuo on jo niin lähellä, mutta silti niin kaukana. Tuo laittoi Taul2 soluun B1 lähtien Taul1:n kaikki sarakkeen A tiedot allekkain, sitten sarakkeen B tiedot allekkain jne.
Jos Taul1:ssä on jokaisella rivillä Tulos, Sukunimi, Etunimi, Osoite jne. niin ne pitäisi saada siis allekkain niin että ensiksi on ensimmäisen rivin Tulos, Sukunimi, Etunimi, Osoite... ja ja vasta sitten toisen Tulos, Sukunimi, Etunimi jne. JariM kirjoitti:
Tuo on jo niin lähellä, mutta silti niin kaukana. Tuo laittoi Taul2 soluun B1 lähtien Taul1:n kaikki sarakkeen A tiedot allekkain, sitten sarakkeen B tiedot allekkain jne.
Jos Taul1:ssä on jokaisella rivillä Tulos, Sukunimi, Etunimi, Osoite jne. niin ne pitäisi saada siis allekkain niin että ensiksi on ensimmäisen rivin Tulos, Sukunimi, Etunimi, Osoite... ja ja vasta sitten toisen Tulos, Sukunimi, Etunimi jne.Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Resize(1, 11).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End Sub
keep Exceling ;-)
@Kunde- JariM
kunde kirjoitti:
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Resize(1, 11).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End Sub
keep Exceling ;-)
@KundeAivan mahtavaa, kiitoksia =)
- JariM
kunde kirjoitti:
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Resize(1, 11).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End Sub
keep Exceling ;-)
@KundeHei,
vielä pitäisi pikkaisen virittäää makroa edellisen pohjalta. Tiedoston Taul1:ssä sarakkeessa A on siis Tulos ja tuloksen kanssa samalla rivillä henkilön tiedot. Mitenkä saan alla olevan makron pohjalta tiedot eriteltyä kolmeen eri välilehteen niin että
- Taul2:n sarakkeeseen B siirtyvät allekkain niiden rivien tiedot joissa tuloksena (Taul1:n sarake A) on Ympyrä
- Taul3:n sarakkeeseen B ne, joissa tuloksena on Kolmio ja
- Taul4:n sarakkeeseen B ne rivit joissa tuloksena on Neliö
Alla on nimimerkin kunde tekemä makro:
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Resize(1, 11).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End Sub JariM kirjoitti:
Hei,
vielä pitäisi pikkaisen virittäää makroa edellisen pohjalta. Tiedoston Taul1:ssä sarakkeessa A on siis Tulos ja tuloksen kanssa samalla rivillä henkilön tiedot. Mitenkä saan alla olevan makron pohjalta tiedot eriteltyä kolmeen eri välilehteen niin että
- Taul2:n sarakkeeseen B siirtyvät allekkain niiden rivien tiedot joissa tuloksena (Taul1:n sarake A) on Ympyrä
- Taul3:n sarakkeeseen B ne, joissa tuloksena on Kolmio ja
- Taul4:n sarakkeeseen B ne rivit joissa tuloksena on Neliö
Alla on nimimerkin kunde tekemä makro:
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Resize(1, 11).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End SubSub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
Worksheets("Taul3").Range("B:B") = ""
Worksheets("Taul4").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Offset(0, 1).Resize(1, 11).Copy
Select Case LCase(solu)
Case "ympyrä"
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Case "neliö"
Range("Taul3!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Case "kolmio"
Range("Taul4!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Case Else
End Select
Next
Application.CutCopyMode = False
End Sub- macroista_tietämätön
kunde kirjoitti:
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
Worksheets("Taul3").Range("B:B") = ""
Worksheets("Taul4").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Offset(0, 1).Resize(1, 11).Copy
Select Case LCase(solu)
Case "ympyrä"
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Case "neliö"
Range("Taul3!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Case "kolmio"
Range("Taul4!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Case Else
End Select
Next
Application.CutCopyMode = False
End SubTerve!
Sellaista olisin kysellyt, että mitenkäs jos haluaisi tuosta viestiketjun alussa olevasta esimerkistä
ottaa tuohon transponointiin vaikka vain A ja C sarakkeet. Eli tuo alla oleva makro toimii muuten mutta, pitäisi saada otettua vain osa sarakkeista mukaan?
Alla on nimimerkin kunde tekemä makro:
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Resize(1, 11).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End Sub macroista_tietämätön kirjoitti:
Terve!
Sellaista olisin kysellyt, että mitenkäs jos haluaisi tuosta viestiketjun alussa olevasta esimerkistä
ottaa tuohon transponointiin vaikka vain A ja C sarakkeet. Eli tuo alla oleva makro toimii muuten mutta, pitäisi saada otettua vain osa sarakkeista mukaan?
Alla on nimimerkin kunde tekemä makro:
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Resize(1, 11).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End SubSub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
'a- sarake
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
'c sarake
vika = Range("Taul1!C65536").End(xlUp).Row
For Each solu In Range("Taul1!C1:C" & vika)
solu.Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End Sub
Keep EXCELling
@Kunde- macroista_tietämätön
kunde kirjoitti:
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
'a- sarake
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
'c sarake
vika = Range("Taul1!C65536").End(xlUp).Row
For Each solu In Range("Taul1!C1:C" & vika)
solu.Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End Sub
Keep EXCELling
@KundeTuo edellinen kunde:n tekemä makro laittoi sarakkeen A tiedot ensin Taul2 sarakkeeseen B
ja siihen perään sarakkeen c tiedot.
Tarkoitin, että Taul2 sarakkeeseen B tulisi ensin Taul1 solun A1 tieto, sitten solun C1, sitten
A2, sitten C2.
kiitoksia kaikista neuvoista. macroista_tietämätön kirjoitti:
Tuo edellinen kunde:n tekemä makro laittoi sarakkeen A tiedot ensin Taul2 sarakkeeseen B
ja siihen perään sarakkeen c tiedot.
Tarkoitin, että Taul2 sarakkeeseen B tulisi ensin Taul1 solun A1 tieto, sitten solun C1, sitten
A2, sitten C2.
kiitoksia kaikista neuvoista.Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:C" & vika)
solu.Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End Sub- macroista_tietämätön
kunde kirjoitti:
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:C" & vika)
solu.Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End Subkunde,
tuo edellinen makro toimii muuten, mutta siihen tulee se b sarake mukaan,
vaikka se pitäisi jättää pois. Eli ainoastaan a ja c pitäisi tulla macroista_tietämätön kirjoitti:
kunde,
tuo edellinen makro toimii muuten, mutta siihen tulee se b sarake mukaan,
vaikka se pitäisi jättää pois. Eli ainoastaan a ja c pitäisi tullaSub Transponoi()
Dim vika As Long
Dim vika2 As Long
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
vika2 = Range("Taul1!C65536").End(xlUp).Row
If vika < vika2 Then
vika = vika2
End If
For Each solu In Range("A1:A" & vika)
solu.Copy Range("Taul2!B65536").End(xlUp).Offset(1, 0)
solu.Offset(0, 2).Copy Range("Taul2!B65536").End(xlUp).Offset(1, 0)
Next
Application.CutCopyMode = False
End Sub- macroista_tietämätön
kunde kirjoitti:
Sub Transponoi()
Dim vika As Long
Dim vika2 As Long
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
vika2 = Range("Taul1!C65536").End(xlUp).Row
If vika < vika2 Then
vika = vika2
End If
For Each solu In Range("A1:A" & vika)
solu.Copy Range("Taul2!B65536").End(xlUp).Offset(1, 0)
solu.Offset(0, 2).Copy Range("Taul2!B65536").End(xlUp).Offset(1, 0)
Next
Application.CutCopyMode = False
End SubHei,
pientä viilausta vielä. Edellinen koodi itsessään toimii, mutta osassa kopioitavista soluista on kaavoja jolloin makro kopio koko kaavan ja liitettäessä muuttaa tietysti indeksöintiä. Olisiko makroa mahdollista muokata niin, että se kopioisi ainoastaan solussa olevan lopputuloksen eikä kaavaa. macroista_tietämätön kirjoitti:
Hei,
pientä viilausta vielä. Edellinen koodi itsessään toimii, mutta osassa kopioitavista soluista on kaavoja jolloin makro kopio koko kaavan ja liitettäessä muuttaa tietysti indeksöintiä. Olisiko makroa mahdollista muokata niin, että se kopioisi ainoastaan solussa olevan lopputuloksen eikä kaavaa.Sub Transponoi()
Dim vika As Long
Dim vika2 As Long
Dim solu As Range
On Error Resume Next
Application.ScreenUpdating = False
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
vika2 = Range("Taul1!C65536").End(xlUp).Row
If vika < vika2 Then
vika = vika2
End If
For Each solu In Range("A1:A" & vika)
solu.Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
solu.Offset(0, 2).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub- macroista_tietämätön
kunde kirjoitti:
Sub Transponoi()
Dim vika As Long
Dim vika2 As Long
Dim solu As Range
On Error Resume Next
Application.ScreenUpdating = False
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
vika2 = Range("Taul1!C65536").End(xlUp).Row
If vika < vika2 Then
vika = vika2
End If
For Each solu In Range("A1:A" & vika)
solu.Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
solu.Offset(0, 2).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Subkiitoksia kundelle erittäin paljon vastauksista, nyt toimii täydellisesti!
- macroista_tietämätön
macroista_tietämätön kirjoitti:
kiitoksia kundelle erittäin paljon vastauksista, nyt toimii täydellisesti!
Iloitsin sitten liian aikaisin täydellisestä toiminnasta, C sarakkeen arvot hiukan muuttuivat. Osassa C sarakkeen soluissa kaavan lopputulokseksi tulee #N/A, nämä solut pitäisi jättää kopiomatta, mutta kohteena olevaan B sarakkeeseen ei saisi tulla tyhjää solua.
Esimerkkinä: A1=1, C1=5 B1=1
A2=2, C2=#N/A B2=5
A3=3, C3=7 B3=2
B4=3
B5=7 macroista_tietämätön kirjoitti:
Iloitsin sitten liian aikaisin täydellisestä toiminnasta, C sarakkeen arvot hiukan muuttuivat. Osassa C sarakkeen soluissa kaavan lopputulokseksi tulee #N/A, nämä solut pitäisi jättää kopiomatta, mutta kohteena olevaan B sarakkeeseen ei saisi tulla tyhjää solua.
Esimerkkinä: A1=1, C1=5 B1=1
A2=2, C2=#N/A B2=5
A3=3, C3=7 B3=2
B4=3
B5=7Sub Transponoi()
Dim vika As Long
Dim vika2 As Long
Dim solu As Range
On Error Resume Next
Application.ScreenUpdating = False
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
vika2 = Range("Taul1!C65536").End(xlUp).Row
If vika < vika2 Then
vika = vika2
End If
For Each solu In Range("A1:A" & vika)
solu.Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
If Not solu.Offset(0, 2).Text = "#N/A" Then
solu.Offset(0, 2).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Keep EXCELling
@Kunde- macroista_tietämätön
kunde kirjoitti:
Sub Transponoi()
Dim vika As Long
Dim vika2 As Long
Dim solu As Range
On Error Resume Next
Application.ScreenUpdating = False
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
vika2 = Range("Taul1!C65536").End(xlUp).Row
If vika < vika2 Then
vika = vika2
End If
For Each solu In Range("A1:A" & vika)
solu.Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
If Not solu.Offset(0, 2).Text = "#N/A" Then
solu.Offset(0, 2).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Keep EXCELling
@KundeToimii! kiitoksia jälleen kerran.
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Kuvat! Dannyyn liitetty Helmi Loukasmäki, 22, on puhjennut naisena kukkaan - Some sekoaa: "Sä..."
Ooo, kaunis aikuinen nainen Helmistä on kasvanut siinä yli 80-vuotiaan Dannyn rinnalla! Katso uudet kuvat: https://ww685623- 613764
Suodatinpussin kastelemalla saa parempaa kahvia
Kokeilin niksiä ja kyllä tämä kahvi on parempaa nyt. Ei lainkaan maistu paperiselta. Huljuttelee hanan alla suppiloa pap1532755Tidätkö nainen
että suoraan sanottuna v.tut.aa että pääsit näin lähelle minua. Ei olisi oikeasti aikaa tähän mutta silti aina välillä o1052196Mikä on kaivattusi etunimi?
Otsikossa siis on kysymys eriteltynä. Vain oikeat vastaukset hyväksytään.1092045Oho! Arja Koriseva paljastaa TTK:n ekasta suorasta lähetyksestä: "On vähän ärsyttävä yhtälö!"
Upea Arja Koriseva! Tsemppiä haasteelliseen tilanteeseen! Lue lisää: https://www.suomi24.fi/viihde/oho-arja-koriseva-211329Onkohan sinulla kaikki hyvin?
Nyt vähän sellainen outo tunne tuli. Sinun asiasi niin ei minulle toki tarvitse kertoa. Kunhan mietin...381297En kestä katsoa
Sitä miten sinusta on muut kiinnostuneita. Olen kateellinen. Siksi pitäisi lähteä pois961278Huikeeta, mahtavaa, ihan mielettömän upeeta
Me ostettiin talo Espanjasta. Tosin saadaan käyttää sitä vain muutama viikko vuodessa kun on monta muutakin ostajaa! M1951232- 1731146