Discussion :

[albius21]

Bonjour à tous,

Je cherche de l'aide pour concevoir une macro qui me permettrait de compter automatiquement des valeurs dans une colonne à partir de deux references i et j.

Je dispose d'un fichier dans lequel j'ai trois colonnes.

une première (i) ou il y a les abscisses, une seconde (j) avec les ordonnées et une troisième avec une valeur binaire 1 ou 0.

On note chaque point M(i,j) et on souhaite additionner les 1 pour chaque point M(i,j) contenus dans un perimètre M'(i-1,j-1) à M''(i+1,j+1) soit un carré de 8 cellules entourant le point M voire les 24 cellules qui entourent le point M(i,j).

J'espère que j'ai été clair.

Le but construire une fonction dynamique de diffusion sur le principe des automates cellulaires.

[zyhack]

Bonjour et bienvenue sur le forum

j'espère avoir bien compris ce que tu veux et j'ai supposé que les valeurs commencé en ligne 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Sub compte()
  Dim I As Single, J As Single, Ii As Single, Jj As Single
  Dim total As Integer, C As Range, entree As Variant
 
entree = InputBox("Valeur de I")
If IsNumeric(entree) Then I = CSng(entree) Else MsgBox "erreur de saisie": Exit Sub
entree = InputBox("Valeur de J")
If IsNumeric(entree) Then J = CSng(entree) Else MsgBox "erreur de saisie": Exit Sub
 
'Boucle dans les valeurs a partir de la ligne 2
For Each C In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
  'Vérifier qu'il s'agit bien de chiffre Col A et Col B
  If IsNumeric(C.Value) And IsNumeric(C.Offset(0, 1).Value) Then
    'récupère les valeurs
    Ii = C.Value
    Jj = C.Offset(0, 1).Value
 
    If Ii >= I - 1 And Ii <= I + 1 And Jj >= J - 1 And Jj <= J + 1 Then
      total = total + C.Offset(0, 2).Value
    End If
  End If
Next
MsgBox "Total = " & total
End Sub

[albius21]

Merci pour cette reponse tres rapide mais je ne suis pas sur d'avoir été assez clair aussi je vais peut être ajouter une capture d'image pour que l'on puisse visualiser le fichier de base.


PS je ne suis pas informaticien de formation mais simplement geographe et cherche à faire une petite appli pour un Système d'information géographique via un export sous excel donc a ceux qui me donnent une reponse essayez d'être explicite et simple.
J'ai a peu pres compris le precedent programme mais il me manque plus de bases pour pouvoir juger plus en detail, je crois que le programme comporte des elements que je ne souhaite pas. Aussi, si vous proposez qq chose, evitez les commandes trop complexes et choisissez le simple quitte à faire lourd.

Merci à tous

[zyhack]

Pour etre sur d'avoir bien compris

exemple pour la ligne 4

il faut additionner les cellules (A3+B4) + (A3+B3) + (A3+B5) + (A4+B3) + (A4+B5) + (A5+B5) + (A5+B4) + (A5+B3)

Ce qui signifirait que pour la ligne 2 tous les calculs en rapport avec la ligne précédente (n-1) ne seront pas effectuer et idem pour la derniere ligne et la ligne suivante (n+1)

c'est bien ça ?

[albius21]

Non, en fait ce n'est pas du tout cela. Je cherche à obtenir dans la quatrième colonne D des sommes de la colonne C
soit par exemple pour la ligne 132 de coordonnées j = 2 et i = 12
(car mon fichier dispose d'une matrice de 119 lignes de j sur 103 lignes de i),
On doit donc additionner la troisième colonne pour les couples ij suivants
(1,11), (1,12), (1,13), (2,11), (2,13), (3,11), (3,12) et (3,13) soit les valeurs des cellules
totalligne 132 = C10 + C11 + C12 + C131 + C133 + C250 + C251 + C252
Je me suis aperçu au passage que pour avoir le numero de la ligne de recupération, il faut calculer la formule suivante :
(j-1)*sum(j) + 1 + i comme c'est trié en fonction de j

En esperant que cela pourra aider pour la resolution

[zyhack]

Bonjour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
37
38
39
40
41
Sub compte()
Dim rngPlage As Range, rngCel As Range
Dim rngC As Range, i As Integer, j As Integer
Dim total As Integer
 
Set rngPlage = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each rngCel In rngPlage
  total = 0
  For i = rngCel.Value - 1 To rngCel.Value + 1
 
  Set rngC = rngPlage.Find(i, LookIn:=xlValues, lookat:=xlWhole)
    If Not rngC Is Nothing Then
      firstAddress = rngC.Address
      Do
        'pour i-1
        If i = rngCel.Value - 1 Then
          'vérifier j-1, j, j+1
          If rngC.Offset(0, 1) >= rngCel.Offset(0, 1) - 1 And rngC.Offset(0, 1) <= rngCel.Offset(0, 1) + 1 Then
            total = total + rngC.Offset(0, 2)
          End If
        'pour i
        ElseIf i = rngCel.Value Then
          'vérifier j-1, j+1
          If rngC.Offset(0, 1) = rngCel.Offset(0, 1) - 1 Or rngC.Offset(0, 1) = rngCel.Offset(0, 1) + 1 Then
            total = total + rngC.Offset(0, 2)
          End If
        'pour i+1
        ElseIf i = rngCel.Value + 1 Then
          'vérifier j-1, j, j+1
          If rngC.Offset(0, 1) >= rngCel.Offset(0, 1) - 1 And rngC.Offset(0, 1) <= rngCel.Offset(0, 1) + 1 Then
            total = total + rngC.Offset(0, 2)
          End If
        End If
 
        Set rngC = rngPlage.FindNext(rngC)
      Loop While Not rngC Is Nothing And rngC.Address <> firstAddress
    End If
  Next
  rngCel.Offset(0, 3) = total
Next
End Sub