Discussion :

[gigalia]

Bonjour à tous,

Voila je vous résume mon soucis. Dans la colonne A, j'ai des chiffres allant de 1 à 100 000 suivi d'une lettre pouvant aller de A à Z (en MAJ). Exemple (A1 = 1A ; A2 = 1B ; A3 = 2A ; etc) Dans une autre cellule j'aurais un chiffre compris entre 1 et 100 000.

Je veux à l'aide d'un code VBA vérifie que ce chiffre se trouve (ou pas) dans la colonne A, s'il est suivi d'une lettre et d'insérer une ligne avec ce chiffre suivis de la prochaine lettre n'étant pas dans la colonne A.

Oui la je sais, je vous ai tous perdu. Donc je vous donne un exemple. J'ai le chiffre 50. Si dans la colonne A, il y a déja 50A, 50B, 50C, je veux inserer une ligne et marquer 50D.

Voila j'espère que vous m'avez compris ... Merci pour vos réponses.

[Invité]

et si il existe 50Z?

[gigalia]

Les valeurs peuvent aller de A à Z mais vont rarement dépassé E ou F. S'il existe Z je mettrais un message demandant de mettre un autre chiffre.

[Invité]

et que devient 50 dans la colonne B? on la supprime?
si non à la prochaine exécution de la macro on vas créer 50C, 50D,50E....

[gigalia]

Oui à chaque execution la suite continu tant que le chiffre n'est pas changer.

Je te rassure j'ai un segment du code qui va changer le chiffre en fonction de certains critères

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
Function CHAR(v As Long) As String
Dim I As Integer
Dim T As String
 
While SerchXls(ActiveSheet.Range("A:A"), ActiveSheet.Range("A1"), v & Chr(65 + I), True) <> 0
I = I + 1
Wend
CHAR = v & Chr(65 + I)
End Function
Function SerchXls(Myrange As Range, MyCellule As Range, strRecherche, EntierCell As Boolean) As Long '
On Error Resume Next
SerchXls = 0
   SerchXls = Myrange.Cells.Find(What:=strRecherche, After:=MyCellule, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=EntierCell).Row
  'If SerchXls <= MyCellule.Row Then SerchXls = 0
End Function
Sub test()
Dim r As Range
Set r = ActiveSheet.Range(ActiveSheet.Cells(1, 2), ActiveSheet.Cells(ActiveSheet.Rows.Count, 2).End(xlUp))
For I = 1 To r.Rows.Count
l = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
     If Trim("" & ActiveSheet.Cells(1, 1)) <> "" Then l = l + 1
     If Trim("" & r(I, 1)) <> "" Then ActiveSheet.Cells(l, 1) = CHAR(r(I, 1))
Next
End Sub