que tu ne connaissais pas (ceci-dit on te l'a rappelé au moins deux fois), parce que: Regarde la différence entre: Dim rng As Range, cell As Range Dim x As Integer x = 1 For Each cell In Columns(1).Cells If cell.Interior.ColorIndex = 15 Then If rng Is Nothing Then Set rng = cell rng.Offset(2, 1).Select With ActiveCell.Value.Find(What:="", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlDown, MatchCase:=False, SearchFormat:=False).Select Do Until ActiveCell.Value.Found(IsEmpty(ActiveCell)) = True x = x + 1 Loop Set rng = Range("rng").Resize(RowSize:=x) End With End If End If Next cell End Sub Et: <code vb> Dim rng As Range, cell As Range Dim x As Integer x = 1 For Each cell In Columns(1).Cells If cell.Interior.ColorIndex = 15 Then If rng Is Nothing Then Set rng = cell rng.Offset(2, 1).Select With ActiveCell.Value.Find(What:="", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlDown, MatchCase:=False, SearchFormat:=False).Select Do Until ActiveCell.Value.Found(IsEmpty(ActiveCell)) = True x = x + 1 Loop Set rng = Range("rng").Resize(RowSize:=x) End With End If End If Next cell End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionDim NombreDeLignes As Integer NombreDeLignes = List1.ListCount
Sub detectecouleurtest4() Dim rng As Range, cell As Range, rlast As Range, rng2 As Range, myString As String Dim MyDataObj As New DataObject Dim Presspp As New DataObject For Each cell In Columns(1).Cells If cell.Interior.ColorIndex = 15 Then If rng Is Nothing Then Set rng = cell rng.Activate MsgBox rng ActiveCell.Offset(2, 1).Select MsgBox ActiveCell.Address Set rlast = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlValues, SearchDirection:=xlNext) MsgBox rlast.Address Range(ActiveCell, rlast).Select Set rng2 = Selection MsgBox rng2.Address rng2.Offset(-1, 0).Select MsgBox rng2.Address Application.SendKeys ("{Down}") 'Like Pushing the Down-Arrow Key DoEvents If IsEmpty(ActiveCell) Then Exit Sub myString = ActiveCell.Value Application.SendKeys ("{Down}") DoEvents While Not IsEmpty(ActiveCell) myString = myString & ActiveCell.Value Application.SendKeys ("{Down}") DoEvents Wend MsgBox myString With MyDataObj .SetText myString .PutInClipboard End With rng.Offset(1, 5).Select Presspp.GetFromClipboard ActiveCell = Presspp.GetText Application.CutCopyMode = False End If End If Set cell = Nothing Set rng = Nothing Set rlast = Nothing Set rng2 = Nothing Next cell End Sub
Sub erreurfinal() Dim rng As Range, cell As Range, rlast As Range, rng2 As Range, myString As String, machaine As String Dim MyDataObj As New DataObject Dim Presspp As New DataObject For Each cell In Columns(1).Cells If cell.Interior.ColorIndex = 15 Then If rng Is Nothing Then Set rng = cell rng.Activate ActiveCell.Offset(2, 1).Select Set rlast = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlValues, SearchDirection:=xlNext) Range(ActiveCell, rlast).Select Set rng2 = Selection If IsEmpty(ActiveCell) Then Exit Sub myString = ActiveCell.Value Application.SendKeys ("{Down}") DoEvents While Not IsEmpty(ActiveCell) myString = myString & ActiveCell.Value Application.SendKeys ("{Down}") DoEvents Wend With MyDataObj .SetText myString .PutInClipboard End With rng.Offset(1, 5).Select Presspp.GetFromClipboard ActiveCell = Presspp.GetText Application.CutCopyMode = False End If End If Set cell = Nothing Set rng = Nothing Set rlast = Nothing Set rng2 = Nothing Next cell For Each cell In Columns(6).Cells If cell.Interior.ColorIndex = 15 Then If rng Is Nothing Then Set rng = cell rng.Activate ActiveCell.Offset(1, 0).Select machaine = ActiveCell.Value If Right(machaine, 8) "BBBBBBBB" Or Left(machaine, 8) "AAAAAAAA" Then ActiveCell.Font.ColorIndex = 3 End If End If End If Set cell = Nothing Set rng = Nothing Next cell End Sub
Sub erreurfinal2() Dim myVar As Double Dim i As Long, B As Long, e As Long 'Parcoure toute la colonne A jusque la dernière 'cellule renseignée (non vide) For i = 1 To Range("A65536").End(xlUp).Row If Cells(i, "A").Interior.ColorIndex = 15 Then 'Cherche la dernière cellule avant une vide 'Dans colonne B B = Cells(i + 2, "B").End(xlDown).Row 'Aditionne les cellules de A(i) à A(b) For e = i To B myVar = myVar + Cells(e, "A").Value Next e Cells(i + 1, 6).Value = myVar myVar = 0 End If Next i End Sub
myVar = myVar & Cells(e, "A").Value
<html> <style type="text/css"> table.tableizer-table {border: 1px solid #CCC; font-family: Arial, Helvetica, sans-serif; font-size: 12px;} .tableizer-table td {padding: 4px; margin: 3px; border: 1px solid #ccc;} .tableizer-table th {background-color: #104E8B; color: #FFF; font-weight: bold;} </style> Type |Name |gnanna |gnannb |gnannc | | ---- Référence7643, , , , , , ---- qualif1, , , , , Référence7643qualif1, ---- , AA, , , , , ---- , BB, , , , , ---- , BB, , , , , ---- , BB, , , , , ---- , BB, , , , , ---- qualif2, , , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- Référence7644, , , , , , ---- qualif1, , , , , 0Référence7644qualif1, ---- , AA, , , , , ---- , BB, , , , , ---- , BB, , , , , ---- qualif2, , , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- Référence7670, , , , , , ---- qualif1, , , , , 0Référence7670qualif1, ---- , AA, , , , , ---- , BB, , , , , ---- qualif2, , , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- , INUTILE, , , , , ---- , INUTILE </html>
MyVar =""pour enlever les 0 du début...