Macro pour fusionner cellules excel
Bonjour,
je souhaite automatiser un fichier excel dont les données vont changer regulierement. Il y a trois collones sur lesquelles je souhaite fusionner les doublons (j'ai déja trié par odre alpha mes collones). Mes données sont des chaines de caractères et j'ai 1000 lignes dans mon tableau. le nombre de lignes est également suceptible de changer dans le prochain fichier auquel je devrais appliquer la macro.
J'ai fais un code en utilisant une boucle while et une valeur boolean mais je suis bloqué. Je dois me planter au niveau des paramètres d'entrés ou bien j'oublie une variable. voila mon code(je débute dans VBA et ça doit se voir)
Donc en premier je fais la lecture de mon tableau (pour la colloneA). Ensuite je fais ma boucle pour trouver quelles sont les données similaires et je fais l'affichage. Je sais bien qu'il me manque pas mal de choses dans mon code et j'ai vraiment besoin d'aide. Merci à vous si vous pouvez m'aider.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
| Sub saisieBTN(n As Integer)
Dim vbtab2(2000) As String
Dim i As Integer
n = 2000
Worksheets("SalesCredit").Activate
For i = 1 To n
vbtab2(i) = Range("a" & i).Value
Next
End Sub |
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
| Function fusion(n As Integer, vbtab2()) As Boolean
Dim i As Integer
Dim j As Integer
Dim b As Boolean
n = 2000
b = False
While i < n & j < n + 1 And b <> True
If vbtab2(j).Value = vbtab2(i).Value Then
b = True
End If
j = i + 1
Wend
fusion = b
End Function |
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
| Sub AffichageBTN(n As Integer, vbtab2() As String)
Dim i As Integer
If fusion(n, vbtab2()) = True Then
Range("a" & i).Select
Selection.MergeCells = True
End If
End Sub
sub PP()
Call saisieBTN(n)
Call AffichageBTN(n, vbtab2())
end sub |
