Manipuler les adresse des cellules en VBA

Version imprimable

Bonjour ,

Je débute en VBA et je cherche a retrouver des valeurs non nulle dans une plage de données. lorsque la valeur est trouvé je voudrais obtenir les deux première case de cette ligne sur une nouvelle feuille sur deux colonnes la case en question sur une troisième et les deux première cases de la colonnes de la case rechercher sur deux autre colonnes.

Par exemple si mes valeurs sont en E26 R89 et Z9 sur la feuille 1 je voudrais obtenir un tableau sur la feuille 2 qui ressemblerait a ça :

A B C D E

1 A26 B26 E26 E1 E2

2 A89 B89 R89 R1 R2

3 A9 B9 Z9 Z1 Z2

Pour l'instant j'arrive a récupérer les valeurs (ou les adresses) dans une nouvelle feuille mais je n'arrive pas a mettre les 4 autre colonnes.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 Option Explicit Sub tests_selection() Dim SrcWs As Worksheet Set SrcWs = Worksheets("feuil1") Dim FoundAddresses As New Collection Dim iCell As Range For Each iCell In SrcWs.Range("A1:AAU723") If iCell.Value <> 0 Then FoundAddresses.Add iCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) End If Next iCell Dim ResultWs As Worksheet Set ResultWs = Worksheets("result") Dim i As Long For i = 1 To FoundAddresses.Count 'output all addresses from the collection ResultWs.Cells(i, 1).Value = FoundAddresses(i) Next i End Sub

	A	B	C	D	E
1	A26	B26	E26	E1	E2
2	A89	B89	R89	R1	R2
3	A9	B9	Z9	Z1	Z2

Bonjour,

voici un bout de code, à adapter . . .

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
Option Explicit
 
Sub cherche_A1_AAU723()
  '
  Const f1 As String = "feuil1"
  Const f2 As String = "feuil2"
  '
  Dim iCell As Range
  '
  Dim i As Long, r As String
  '
  i = 0
  '
  For Each iCell In Range("A1:AAU723")
    '
    If (iCell.Value <> "") Then
      '
      i = i + 1
      r = iCell.Address
      '
      Sheets(f2).Cells(i, 1).Value = "A" & Mid$(r, InStrRev(r, "$") + 1)
      Sheets(f2).Cells(i, 2).Value = "B" & Mid$(r, InStrRev(r, "$") + 1)
      Sheets(f2).Cells(i, 3).Value = Mid$(Left$(r, InStrRev(r, "$") - 1), 2) & Mid$(r, InStrRev(r, "$") + 1)
      Sheets(f2).Cells(i, 4).Value = Mid$(Left$(r, InStrRev(r, "$") - 1), 2) & "1"
      Sheets(f2).Cells(i, 5).Value = Mid$(Left$(r, InStrRev(r, "$") - 1), 2) & "2"
      '
      Sheets(f2).Cells(i, 7).Value = r
      '
    End If
    '
  Next iCell
  '
  MsgBox " nb : " & i
  '
End Sub

;)

01/04/2018, 17h43
mjpmjp

Bonjour,

Citation:

je voudrais obtenir les deux première case de cette ligne

case1= cells(Ligne,1)
case2= cells(Ligne,2)

@+JP