Excel-luettelon päällekkäisten kohteiden poistaminen makroesimerkkien avulla
Lisätietoja
Microsoft esittää ohjelmointiesimerkkejä vain asian havainnollistamiseksi, ilman suoraa tai epäsuoraa vastuuta niiden toimivuudesta. Tämä sisältää muunmuassa epäsuorat vastuut soveltuvuudesta kaupankäyntiin tai soveltuvuuteen yksilöityyn käyttöön. Tässä artikkelissa oletetaan, että olet perehtynyt käytettyyn ohjelmointikieleen, sekä proseduurien luonti- ja virheenkorjaustyökaluihin. Microsoftin tukihenkilöt voivat auttaa selvittämään tietyn proseduurin toiminnallisuutta, mutta he eivät muokkaa näitä esimerkkejä parantamaan yksittäisen tarpeen toiminnallisuutta eivätkä luo siihen proseduureja.
Esimerkki 1: Poista päällekkäisiä kohteita yhdestä luettelosta
Seuraava mallimakro hakee A1:A100-alueen yksittäisestä luettelosta ja poistaa kaikki luettelon kaksoiskappaleet. Tämä makro edellyttää, että luetteloalueella ei ole tyhjiä soluja. Jos luettelo sisältää tyhjiä soluja, lajittele tiedot nousevaan järjestykseen niin, että kaikki tyhjät solut ovat luettelon lopussa.
Sub DelDups_OneList()
Dim iListCount As Integer
Dim iCtr As Integer
' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False
' Get count of records to search through.
iListCount = Sheets("Sheet1").Range("A1:A100").Rows.Count
Sheets("Sheet1").Range("A1").Select
' Loop until end of records.
Do Until ActiveCell = ""
' Loop through records.
For iCtr = 1 To iListCount
' Don't compare against yourself.
' To specify a different column, change 1 to the column number.
If ActiveCell.Row <> Sheets("Sheet1").Cells(iCtr, 1).Row Then
' Do comparison of next record.
If ActiveCell.Value = Sheets("Sheet1").Cells(iCtr, 1).Value Then
' If match is true then delete row.
Sheets("Sheet1").Cells(iCtr, 1).Delete xlShiftUp
' Increment counter to account for deleted row.
iCtr = iCtr + 1
End If
End If
Next iCtr
' Go to next record.
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
Esimerkki 2: Vertaa kahta luetteloa ja poista päällekkäisiä kohteita
Seuraava mallimakro vertaa yhtä (pää) luetteloa toiseen luetteloon ja poistaa toisen luettelon kaksoiskappaleet, jotka ovat myös pääluettelossa. Ensimmäinen luettelo on taul1 alueella A1:A10. Toinen luettelo on taul2 alueella A1:A100. Jos haluat käyttää makroa, valitse jompikumpi taulukko ja suorita sitten makro.
Sub DelDups_TwoLists()
Dim iListCount As Integer
Dim iCtr As Integer
' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False
' Get count of records to search through (list that will be deleted).
iListCount = Sheets("sheet2").Range("A1:A100").Rows.Count
' Loop through the "master" list.
For Each x In Sheets("Sheet1").Range("A1:A10")
' Loop through all records in the second list.
For iCtr = 1 To iListCount
' Do comparison of next record.
' To specify a different column, change 1 to the column number.
If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
' If match is true then delete row.
Sheets("Sheet2").Cells(iCtr, 1).Delete xlShiftUp
' Increment counter to account for deleted row.
iCtr = iCtr + 1
End If
Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub