Keskustelu: Ohjelmointikysymykset: VBA: Excel vertailu

Edroh [18.11.2010 20:42:04]

Eli mulla on excel taulukko jossa kahdella sarakkeella ihmisten nimiä. Etunimi ja sukunimi. Nyt pitäisi saada verrattua näitä nimiä, esim jos sarakkeessa yksi lukee Jukka Petteri Esimerkkinen, ja toisessa sarakkeessa Jukka Esimerkkinen, niin saisin jotenkin järkevän listan nimistä jotka löytyvät näiltä molemmilta sarakkeilta. Tosiaan nimissä voi olla kaksi etunimeä tai vain yksi, joten pitäisi saada verrattua sisältöä niin, että sarakkeet eivät välttämättä vastaa täysin toisiaan.

Vai onko tähän jokin muu helpompi ratkaisu olemassa, kuten jokin simppeli scripti?

Kiitos jo etukäteen jos joltakin tämmöinen toiminto onnistuu.

Esimerkki taulukosta (nimet hatusta vedettyjä)

     1 (sisältö)                2 (sisältö)                3(tulokset)

|   Jukka Virtanen   |     |   Jorma Jormanen   |     |   Jorma Jormanen   |
|   Paavo Jokinen    |     |   Jukka Virtanen   |     |   Jukka Virtanen   |
|   Päivi Pusakka    |     |   Jaakko Pulu      |
|   Jorma Jormanen   |     |   Kirsti Seppälä   |

neau33 [18.11.2010 21:49:55]

Moi Edroh!

Simppeli homma, isket vaikka tauluun Taul1 komentonapin & napin koodiksi:

Private Sub CommandButton1_Click()

   Dim rivit
   Dim teksti1 As String
   Dim teksti2 As String
   Dim taulu1() As String
   Dim taulu2() As String
   rivit = ActiveSheet.UsedRange.Rows.Count
   Range("C1:C" & CStr(rivit)).Clear

   On Error GoTo ErrorHandler

   For rs2 = 1 To rivit
      teksti1 = Cells(rs2, 2).Text
      teksti1 = Trim(Replace(teksti1, "  ", " "))
      taulu1 = Split(teksti1, " ")
      For rs1 = 1 To rivit
         teksti2 = Cells(rs1, 1).Text
         teksti2 = Trim(Replace(teksti2, "  ", " "))
         taulu2 = Split(teksti2, " ")
         For s1 = LBound(taulu1) To UBound(taulu1)
            For s2 = LBound(taulu2) To UBound(taulu2)
               If taulu1(s1) = taulu2(s2) Then
                  Cells(rs2, 3).Value = _
                  Cells(rs2, 3).Value & taulu1(s1) & " "
               End If
            Next s2
         Next s1
      Next rs1
      Cells(rs2, 3).Value = Trim(Cells(rs2, 3).Text)
      Erase taulu1, taulu2
   Next rs2

   Exit Sub

ErrorHandler:
   MsgBox Error$
   Err.Clear
   On Error GoTo 0

End Sub

Edroh [18.11.2010 22:14:03]

Mikäköhän menee pieleen ku sanotaan että, "cannot run the macro ´Book3.xlsm!jjee´. The macro may not be avaible in this workbook or all macros may be disabled.
En oo näitte makrojen kanssa ennen puuhaillut ollenkaan :/

Grez [18.11.2010 22:24:13]

Ootko sanonut sille, että makroja saa käyttää? Makrovirusten keksimisen jälkeen (joskus 10 vuotta sitten) on uusissa officeissa ollut makrot oletuksena pois päältä kunnes käyttäjä erikseen antaa luvan.

Edroh [18.11.2010 22:38:33]

Nyt onnistu toi salliminen, nyt iski vaa tällästä errorii: "compile error: Ambigunous name detected: CommandButton1_Click"

neau33 [18.11.2010 22:44:36]

Moi taas Edroh!

mikäli kävi näin, niin...

Private Sub CommandButton1_Click() '<- poista tämä rivi
Private Sub CommandButton1_Click()
 'koodia...
 '.........
End Sub
End Sub ' <- ja tämä rivi

Edroh [18.11.2010 22:52:59]

Saan ton macron ajettuu tuol macron teko sivulla, mut en saa sitä yhdistettyy siihe nappiin. Anyway, kun ajoin ton macron tuolla editorissa niin ensinnäkin excel meni aivan jumiin, tod näk koska nimiä yli 4k. Toiseksi, macro printtasi sarakkeelle 3 43 kertaa pelkän etunimen. (mahdollisesti juuri näitä henkilöitä löytyy useampia?) Sukunimiä tuo ei verrannut ja etunimi ja sukunimi eroteltu välilyönnillä.

neau33 [18.11.2010 23:43:45]

Moikka taas Edroh!

Klikkaa työkalurivillä sitä suunnittelutila-kuvaketta, raahaa komentopainike sille työkirjan taululle jossa ne nimet on ja tuplaklikkaa raahaamaasi painiketta. Kun koodikkuna aukeaa niin copy/pasteta oheinen koodi komentopainikkeen Click-tapahtuman koodiksi ja sulje VBA-editori. Klikkaa taas sitä suunnittelu-kuvaketta & paina tauluun raahaamaasi komentonappia...
Mikäli Ohjausobjektit työkalurivi ei ole näkyvissä saat sen esiin valitsemalla valikosta: Työkalut -> Mukauta -> Työkalurivit [x]Ohjausobjekti & Sulje-nappi...

   Dim taulu1() As String
   Dim taulu2() As String
   rivit = ActiveSheet.UsedRange.Rows.Count
   Range("C1:C" & CStr(rivit)).Clear

   On Error GoTo ErrorHandler

   For rs2 = 1 To rivit
      text1 = Cells(rs2, 2).Text
      text1 = Trim(Replace(text1, "  ", " "))
      taulu1 = Split(text1, " ")
      For rs1 = 1 To rivit
         text2 = Cells(rs1, 1).Text
         text2 = Trim(Replace(text2, "  ", " "))
         taulu2 = Split(text2, " ")
         For s1 = LBound(taulu1) To UBound(taulu1)
            For s2 = LBound(taulu2) To UBound(taulu2)
               If taulu1(s1) = taulu2(s2) And _
               InStr(Cells(rs2, 3).Value, taulu1(s1)) = 0 Then
                  Dim existing As Boolean
                  For s3 = 1 To rivit
                     If InStr(Cells(s3, 3), taulu1(s1)) Then
                        existing = True: Exit For
                     End If
                  Next s3
                  If Not existing Then
                     Cells(rs2, 3).Value = _
                     Cells(rs2, 3).Value & taulu1(s1) & " "
                  End If
               End If
            Next s2
         Next s1
      Next rs1
      Cells(rs2, 3).Value = Trim(Cells(rs2, 3).Text)
      Erase taulu1, taulu2
   Next rs2

   Exit Sub

ErrorHandler:
   MsgBox Error$
   Err.Clear
   On Error GoTo 0

Sivun alkuun

Vastaus

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

Kirjautuminen

Haku

Tehtävät

Kilpailu