Odebrat duplicity v aplikaci Excel VBA

Níže se podíváme na program v Excel VBA že odstraní duplikáty.

Situace:

Ve sloupci A máme 10 čísel. Chceme odstranit duplikáty z těchto čísel a umístit unikátní čísla ve sloupci B.

1. Nejprve deklarujeme čtyři proměnné. toAdd typu Boolean, uniqueNumbers typu Integer, i typu Integer a j typu Integer.

Dim toAdd As Boolean, uniqueNumbers As Integer, i As Integer, j As Integer

2. Dále zapíšeme první číslo sloupce A do sloupce B, protože první číslo je vždy "jedinečné".

Cells(1, 2).Value = Cells(1, 1).Value

3. Inicializujeme dvě proměnné. Do sloupce B jsme přidali jedno číslo, proto inicializujeme uniqueNumbers s hodnotou 1. NastavenímAdd to True předpokládáme, že další číslo musí být přidáno také (to samozřejmě není samozřejmě pravda).

uniqueNumbers = 1
toAdd = True

Musíme určit, zda je druhé číslo "jedinečné" nebo ne. To lze provést velmi snadno. Pouze pokud číslo již není ve sloupci B, druhé číslo je třeba přidat do sloupce B.

4. Také je třeba zkontrolovat třetí číslo, čtvrté číslo a podobně. Začneme pro tuto smyčku Pro další.

For i = 2 To 10

5. Nyní přichází nejdůležitější část programu. Pokud se druhé číslo rovná jednomu z čísel ve sloupci B (zatím máme pouze jedno jedinečné číslo), nastavíme se na Přidat na hodnotu FALSE, protože v tomto případě nechceme přidat toto číslo! (Není to "jedinečné ") .V tomto okamžiku uniqueNumbers je stále rovno 1, ale uniqueNumbers může být celý seznam.Za účelem kontroly tohoto seznamu potřebujeme další smyčku For Next.When znovu: pokud číslo, které chceme přidat, se rovná jednomu z čísel v tomto seznamu budeAddd nastaven na hodnotu False a číslo nebude přidáno Přidejte následující řádky kódu:

For j = 1 To uniqueNumbers
    If Cells(i, 1).Value = Cells(j, 2).Value Then
        toAdd = False
    End If
Next j

6. Pouze pokud je toAdd stále pravdivé a není nastaveno na hodnotu FALSE, aplikace Excel VBA potřebuje přidat číslo do sloupce B. Současně inkrementujeme jedinečné čísla číslem 1, protože nyní máme jedno jedinečné číslo. Následující řádky kódu provádějí práci:

If toAdd = True Then
Cells(uniqueNumbers + 1, 2).Value = Cells(i, 1).Value
uniqueNumbers = uniqueNumbers + 1
End If

7. Nakonec nastavíme možnost Přidávat na hodnotu Pravá za předpokladu, že je třeba přidat další číslo (třetí číslo). Opět to není nutně pravda.

toAdd = True

8. Nezapomeňte uzavřít smyčku.

Next i

9. Umístěte své makro do příkazového tlačítka a otestujte ho.

Výsledek: