Keskustelu: Ohjelmointikysymykset: VBA: Luku nimen mukaan (Excel)

Voisikohan joku auttaa kun oma osaaminen ei riitä. Minulla on excelissä taulukko jossa nimiä listattuna (satoja) ja sitten toisella worksheetillä taulukko jossa on noin 10 nimeä joiden perässä luku. Haluaisin, että excel kävisi 200 nimen listan läpi ja etsisi ne tietyt 10 ja sijoittaisi niiden perässä olevan luvun aina oikealle kohdalle siihen 200 listaan.

Heippa help!

tee seuraavanlainen pikku testi:

ensin kirjoittele Työkirjan tauluun Taul1 sarakkeen A soluhin jotain nimiä esim.

Anna A
Anna B
Annssi A
Anssi B
Bertta A
Bertta B
Cecilia C
Cecilia Å
jne.

sit kirjoittele Työkirjan tauluun Taul2 sarakkeen A soluihin jotain nimiä ja sarakkeen B vastaaviin soluhin jotain arvoja esim.

 Anna B      |    123
Annssi A    |    122
Bertta A    |    133
Cecilia C   |    212

sit hae Excelin valikkoriville Ohjausobjektit (jos ei jo ole näkyvissä) ja klikkaa sitä kuvaketta, jossa näky pari erilaista viivainta sekä kynä. Sit klikkaa valintaa Komentopainike (harmaa laatikko) ja piirrä tauluun Taul1 se nappula. Sit tuplaklikkaa sitä nappulaa ja kopioi...
Private Sub CommandButton1_Click()
' & liitä tähän väliin...
End Sub
...allaoleva koodinpätkä:

Dim alueT1, alueT2, soluT1, soluT2

Sheets("Taul2").Activate
alueT2 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Taul1").Activate
alueT1 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)

For Each soluT1 In Sheets("Taul1").Range(alueT1)
 For Each soluT2 In Sheets("Taul2").Range(alueT2)
   If soluT1.Value = soluT2.Value Then
      Cells(soluT1.Row, 2).Value = Sheets("Taul2").Cells(soluT2.Row, 2).Value
   End If
 Next
Next

Application.ScreenUpdating = True

Sit sulje se Visual Basic Editori ja klikkaa taas sitä (viivotin/kynä) kuvaketta Lopeta suunnittelu ja klikkaa sit sitä luomaasi nappulaa...tutki viritelmää ja sovella sit omiin jutskiisi...

Thanks neau33.

Ottaisin mielelläni vielä joltain apuja vastaan. Yritin kehitellä tuota omiin tarkoituksiini ja tavallaan toimii hienosti. Sitten tuli mieleeni sellainen kun pitäisi saada aikaiseksi sellainen loop joka toistaisi tavallaan tällaista. Elikkäs Sheet2:lla on 10 nimen ja arvon joukkkoja monta esim.

1 |Anna |123 | Cecilia|625
2 |Bertta |234 |Anna |428
3 |Anssi |342 |Anu |253
4 |Cecilia|356 |Jaana |112

ja haluaisin että Sheet1:lle tulostuisi aina nimen perään ensin monesko eli 1,2,3 jne ja sitten luku ja sitten seuraavalle kolumnille taas seuraava monesko ja sitten luku....jne.

Eli pitäisi näyttää Sheet1 jotakuinkin sitten tältä:

Anna | 1 | 123 | 2 |428
Anssi | 3 | 342 | |
Bertta | 2 | 234 | |
Anu | | | 3 |253
Cecilia | 4 | 356 | 1 |625
Jaana | | | 4 |112

.. ja niin edelleen.

Jotain tällaista siis pitäisi saada toistumaan:

Sub Button1_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
   End If
 Next
Next

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

Sheets("Sheet2").Activate
areaT4 = "B1:B" & 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, 4).Value = Sheets("Sheet2").Cells(cellT4.Row, 3).Value
   End If
 Next
Next

En nyt tiedä osasinko asiani esittää mitenkään järkevästi, mutta kun nämä ohjelmointi taidot nyt ovat mitä ovat, niin pahoittelut.

Hei.

Törmäsin pieneen lisä ongelmaan, siis sen lisäksi että saisin ohjelmani vielä toistamaan toiminnon muilla riveillä/sarakkeilla. Osaisiko joku auttaa. Tällaista koodia sitten tässä tosiaan yritin ja ongelmaksi tuli, että Sheet1 ensimmäisille riveille on kirjoitettu muuta tekstiä. Kun ohjelmanpätkäni nyt sitten etsi oikeat nimet, joiden perään se asetti luvut se poisti ensimmäisillä riveillä olevan tekstin niistä sarakkeista joihin luvut tulivat. Olen siis ihan kysymysmerkkinä?

Sub Button1_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
   End If
 Next
Next

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

Sheets("Sheet2").Activate
areaT4 = "B1:B" & 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, 4).Value = Sheets("Sheet2").Cells(cellT4.Row, 3).Value
   End If
 Next
Next

Application.ScreenUpdating = True
End sub

Voi sitten olla hankalaa kun ei tajua...