inscription dans cellule (VBA)

[JJ1]

Bonjour à tous,

Hier soir j'ai préparé un fichier que j'ai fini pour connaître la possibilité par VBA (uniquement je pense) d'inscrire dans une cellule deux inscriptions:
en bas de cellule, la "série"
en haut de cellule les valeurs à inscrire correspondantes aux données valeurs.
(en format texte?)

Je joins un bout d'exemple du fichier préparé.

merci de votre aide.
Bonne journée

 

[fanfan38]

Re : inscription dans cellule (VBA)

Bonjour
Je verrai bien une macro dans ce genre là:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 14 Then Exit Sub
Range("R5").Value = CStr(Range("b5").Value) & Chr(13) & Chr(10) & CStr(Range("d6").Value)
End Sub

 

[mapomme]

Re : inscription dans cellule (VBA)

Bonjour JJ1,

Comme je n'ai pas compris grand chose, un exemple pour gérer les formats texte dans une cellule.
Code à mettre dans le module de Feuil1:

Sub toto()
Const Espacement = 2
Dim Nretour
  With Sheets("Feuil1").Cells(5, "r")
    .Value = "9 - > 12" & String(Espacement, vbLf) & "1 - 2"
    Nretour = InStr(.Text, String(Espacement, vbLf))
    With .Characters(Nretour + Espacement, 99).Font
      .FontStyle = "Gras"
      .Size = 14
    End With
  End With
End Sub

 

[JJ1]

Re : inscription dans cellule (VBA)

Bonjour Fanfan, mapomme,
Merci pour vos réponses.
J'explique plus en détail:
le tableau se compose en 4 parties:
série (col A), valeurs (B:F), à inscrire (H:L), les cases numérotées de 1 à 16 en O:R où inscrire.

le principe pour chaque valeur de 1 à 16 est d'inscrire dans sa case la série où il se retrouve et les nombres à inscrire correspondants aussi (H:L)
ex pour la case 4, il faudrait inscrire les séries 1 et 2 en bas et en haut de la case les valeurs à inscrire soit 9 et >12

merci à vous.

 

[mapomme]

Re : inscription dans cellule (VBA)

(re) Bonjour JJ1,

Pas certain d'avoir mieux compris...
Un essai dans le fichier joint.

 

[job75]

Re : inscription dans cellule (VBA)

Bonjour à tous,

Voyez cette macro dans le fichier joint :

Sub Inscrire()
Dim P1 As Range, P2 As Range, col%, Ncol%, cel As Range
Dim n&, c1 As Range, c2 As Range, t As Boolean
Set P1 = [O5:R8]
Set P2 = [B5:F65536]
col = P2.Column - 1 'colonne du n° de série
Ncol = P2.Columns.Count
P1.ClearContents
For Each cel In P1
  n = n + 1
  Set c1 = P2.Find(n, P2(P2.Rows.Count, Ncol), xlValues, xlWhole)
  If Not c1 Is Nothing Then
    Set c2 = P2.Find(n, c1)
    t = c2.Address <> c1.Address
    cel = c1(1, Ncol + 2) & IIf(t, " - " & c2(1, Ncol + 2), "") & vbLf _
      & Cells(c1.Row, col) & IIf(t, " - " & Cells(c2.Row, col), "")
    With cel.Characters(InStr(cel, vbLf)).Font
      .Size = 14
      .Bold = True
    End With
  End If
Next
End Sub

A+

 

[job75]

Re : inscription dans cellule (VBA)

Re,

Quand on re-clique sur le bouton l'effacement du tableau est visible.

Ceci l'évite :

Sub Inscrire()
Dim P1 As Range, P2 As Range, col%, Ncol%, cel As Range
Dim n&, c1 As Range, c2 As Range, t As Boolean
Set P1 = [O5:R8]
Set P2 = [B5:F65536]
col = P2.Column - 1 'colonne du n° de série
Ncol = P2.Columns.Count
For Each cel In P1
  n = n + 1
  Set c1 = P2.Find(n, P2(P2.Rows.Count, Ncol), xlValues, xlWhole)
  If c1 Is Nothing Then
    cel = ""
  Else
    Set c2 = P2.Find(n, c1)
    t = c2.Address <> c1.Address
    cel = c1(1, Ncol + 2) & IIf(t, " - " & c2(1, Ncol + 2), "") & vbLf _
      & Cells(c1.Row, col) & IIf(t, " - " & Cells(c2.Row, col), "")
    With cel.Characters(InStr(cel, vbLf)).Font
      .Size = 14
      .Bold = True
    End With
  End If
Next
End Sub

Fichier (2).

A+

 

[JJ1]

Re : inscription dans cellule (VBA)

Bonsoir à tous,
merci à vous pour ces solutions.
Je vais tester ce WE tranquillement.

Bonne soirée et merci beaucoup.