Rapport de message :*
 

Re: DECALER

Titre du sujet : Re: DECALER
par jad73 le 05/10/2010 17:40:02

bonjour guy,le forum
n'étant pas très doué en vba je suppose qu'il fallait recopier les ligne de ton code dans le mien;c'est ce que j'ai fait,j'ai gardé les anciennes lignes avec un ' devant
lorsque je clique sur calcul j'ai un message avec"erreur de compilation,variable non définie",la ligne "bs = -1" est en bleu.
voici le code:
Sub toto_1(cible As Range, data As Range, tmin%, tmax%)
Dim mgPlageRes As Range
'Dim oDat(), v#, n%, dn%, bs%, i&, j%, tmp#, s$, oCel As Range, oColl As New Collection
  bs = -1
  For Each oCel In data
    If Not IsEmpty(oCel) Then bs = bs + 1: ReDim Preserve oDat(bs): oDat(bs) = oCel.Value
  Next oCel
  tmax = WorksheetFunction.Min(bs, Abs(tmax) - bs * (tmax = 0))
  tmin = WorksheetFunction.Min(tmax, WorksheetFunction.Max(1, tmin))
  With cible
    v = Round(cible.Value, 5)
    If Not IsEmpty(.Offset(1, 0)) Then .Offset(1, 0).Resize(.End(xlDown).Row - 1, 1).ClearContents
    If bs > -1 Then
      For i = 0 To bs - 1
        For j = i + 1 To bs
          If oDat(i) < oDat(j) Then tmp = oDat(i): oDat(i) = oDat(j): oDat(j) = tmp
        Next j
      Next i
      For i = 0 To 2 ^ (bs + 1) - 1
        tmp = 0
        n = 0
        For j = 0 To bs
          dn = i \ (2 ^ j) Mod 2
          tmp = tmp + oDat(j) * dn
          n = n + dn
        Next j
        If Round(tmp, 5) = v Then
            If (tmin <= n) * (n <= tmax) Then
            s = "="
            For j = 0 To bs
            s = s & IIf(i \ (2 ^ j) Mod 2, oDat(j) & ";", "")
            's = s & IIf(i \ (2 ^ j) Mod 2, oDat(j) & "+", "")
            Next j
            Application.DisplayAlerts = False
            On Error Resume Next
            'plage des résultats est posée
            Set mgPlageRes = .Offset(1, 0).Resize(oColl.Count, 1)
            'oColl.Add Item:=Left$(s, Len(s) - 1), Key:=Left$(s, Len(s) - 1)
            'les données y sont déposées
             mgPlageRes.Value = oDat
            'les données sont distribuées dans les colonnes adjacentes
             For Each oCel In mgPlageRes.Cells
              oCel.TextToColumns Destination:=oCel.Offset(0, 1), DataType:=xlDelimited, consecutivedelimiter:=True, semicolon:=True
           
            On Error GoTo 0
          End If
        End If
      Next i
      If oColl.Count Then
        ReDim oDat(1 To oColl.Count, 0)
        For i = 1 To oColl.Count
          oDat(i, 0) = oColl(i)
        Next i
        .Offset(1, 0).Resize(oColl.Count, 1).Value = oDat
      End If
    End If
  End With
End Sub

Private Sub CommandButton1_Click()
  'Syntaxe :
  'toto_1 Cellule contenant le nombre à atteindre, Zone des données, Nb.minimum de termes, Nb.maximum de termes
  toto_1 [J1], Range("A5:H6"), [B2], [B3]
End Sub

'Private Sub Worksheet_Change(ByVal Target As Range)
'  If Target.Address(0, 0) = "N1" Then toto
'End Sub

merci