Private Sub Worksheet_Change(ByVal Target As Range)
With [MaMerveilleusePlageDeCellules]
If Not Intersect(Target, .Cells) Is Nothing Then
Dim t(), c As Range, n As Long
ReDim t(1 To .Count, 1 To 1)
For Each c In .Cells
If Not IsEmpty(c) Then
n = n + 1
t(n, 1) = c
End If
Next
Application.EnableEvents = False
.Cells = t
Application.EnableEvents = True
End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
With [MaMerveilleusePlageDeCellules]
If Not Intersect(Target, .Cells) Is Nothing Then
Dim t(), c As Range, n As Long
ReDim t(1 To .Count, 1 To 2)
For Each c In .Cells
If Not IsEmpty(c) Then
n = n + 1
t(n, 1) = c
t(n, 2) = c(1, 2)
End If
Next
Application.EnableEvents = False
.Resize(, 2) = t
Application.EnableEvents = True
End If
End With
End Sub
Call EraseEmptyRows([ListeItems1].Columns(1))
Call EraseEmptyRows([ListeItems1].Columns(1).Cells)
Sub EraseEmptyRows(plage As Range)
Dim t(), c As Range, n As Long
ReDim t(1 To plage.Count, 1 To 2)
For Each c In plage
If Not IsEmpty(c) Then
n = n + 1
t(n, 1) = c
t(n, 2) = c(1, 2)
End If
Next
Application.EnableEvents = False
plage.Resize(, 2) = t
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [MaMerveilleusePlageDeCellules]) Is Nothing Then
Set d = CreateObject("scripting.dictionary")
For Each c In [MaMerveilleusePlageDeCellules]
If Not IsEmpty(c) Then d(c.Value) = c.Offset(, 1)
Next c
Application.EnableEvents = False
[MaMerveilleusePlageDeCellules].Resize(, 2).ClearContents
[b3].Resize(d.Count) = Application.Transpose(d.keys)
[c3].Resize(d.Count) = Application.Transpose(d.items)
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [ListeItems1].Columns(1)) Is Nothing Then
Dim d As Object, c As Range, ad1 As String, ad2 As String
Set d = CreateObject("scripting.dictionary")
ad1 = [ListeItems1].Cells(1, 1).Address
ad2 = [ListeItems1].Cells(1, 2).Address
For Each c In [ListeItems1].Columns(1).Cells
If Not IsEmpty(c) Then d(c.Value) = c.Offset(, 1)
Next c
Application.EnableEvents = False
[ListeItems1].Columns(1).Resize(, 2).ClearContents
'[b3].Resize(d.Count) = Application.Transpose(d.keys)
Range(ad1).Resize(d.Count) = Application.Transpose(d.keys)
'Range(ad2).Resize(d.Count) = Application.Transpose(d.keys) 'ça ne marche pas
[c3].Resize(d.Count) = Application.Transpose(d.items)
Application.EnableEvents = True
End If
End Sub
Sub Test()
Dim t, i
Application.ScreenUpdating = False
t = Timer
For i = 1 To 1000
[B3] = [B3]
Next
MsgBox Timer - t
End Sub
et je ne comprends pas pourquoi pour Range(ad2) ça ne marche pas.