W
woo
Guest
Bonjour à tous,
J'ai modifié un code vba pour extraire des nombres dans une plage de cellule, mais extraire que les 6 premiers, et l'instruction "If m < 6 Then" ne fonctionne pas.
Un code vba recupérer dans "extraire_c.zip" de M. Pierre Jean.
Sub ext()
Dim Derlig As Integer, Plage As Range, Cel As Range, Place As Byte, i As Byte
Dim oCel As Range, x, y, l, m As Long
Application.DisplayAlerts = False
With Sheets("essai2")
' Conversion des places
Derlig = .Range("J65000").End(xlUp).Row
With .Range("J8:J25")
.Replace "(09) ", ""
.Replace "(09),(08)", ""
With Range("J8:J27")
For Each oCel In .Cells
x = Split(oCel.Value, " ")
If UBound(x) >= 0 Then
For i = 0 To UBound(x)
y = Split(x(i), ")")
On Error Resume Next
x(i) = y(UBound(y))
x(i) = Left$(x(i), Len(x(i)) - 1)
On Error GoTo 0
If Not IsNumeric(x(i)) Then x(i) = "0"
Next i
ReDim y(0 To UBound(x)) As Variant
For i = 0 To UBound(x)
If IsNumeric(x(i)) Then y(i) = CInt(x(i)) Else y(i) = x(i)
Next i
Range(Cells(oCel.Row, [K8].Column), Cells(oCel.Row, [K8].Column + UBound(x))).Value = y '***
End If
Next oCel
For m = 0 To UBound(x)
If m < 6 Then
Cells(7 + n, 11 + m) = x(m)
End If
Next m
End With
End With
End With
Application.ScreenUpdating = True
End Sub
Svp quel solution
Merci
woo.
J'ai modifié un code vba pour extraire des nombres dans une plage de cellule, mais extraire que les 6 premiers, et l'instruction "If m < 6 Then" ne fonctionne pas.
Un code vba recupérer dans "extraire_c.zip" de M. Pierre Jean.
Sub ext()
Dim Derlig As Integer, Plage As Range, Cel As Range, Place As Byte, i As Byte
Dim oCel As Range, x, y, l, m As Long
Application.DisplayAlerts = False
With Sheets("essai2")
' Conversion des places
Derlig = .Range("J65000").End(xlUp).Row
With .Range("J8:J25")
.Replace "(09) ", ""
.Replace "(09),(08)", ""
With Range("J8:J27")
For Each oCel In .Cells
x = Split(oCel.Value, " ")
If UBound(x) >= 0 Then
For i = 0 To UBound(x)
y = Split(x(i), ")")
On Error Resume Next
x(i) = y(UBound(y))
x(i) = Left$(x(i), Len(x(i)) - 1)
On Error GoTo 0
If Not IsNumeric(x(i)) Then x(i) = "0"
Next i
ReDim y(0 To UBound(x)) As Variant
For i = 0 To UBound(x)
If IsNumeric(x(i)) Then y(i) = CInt(x(i)) Else y(i) = x(i)
Next i
Range(Cells(oCel.Row, [K8].Column), Cells(oCel.Row, [K8].Column + UBound(x))).Value = y '***
End If
Next oCel
For m = 0 To UBound(x)
If m < 6 Then
Cells(7 + n, 11 + m) = x(m)
End If
Next m
End With
End With
End With
Application.ScreenUpdating = True
End Sub
Svp quel solution
Merci
woo.
Pièces jointes
Dernière modification par un modérateur: