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ä |
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 SubMikä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 :/
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.
Nyt onnistu toi salliminen, nyt iski vaa tällästä errorii: "compile error: Ambigunous name detected: CommandButton1_Click"
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
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ä.
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 0Aihe on jo aika vanha, joten et voi enää vastata siihen.