recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

[laurent59]

Bonjour à tous.
Voila je vous explique :
J ai un classeur avec une premiere feuille dans laquelle se trouve en colonne A une liste de noms
Ensuite mon classeur comporte toutes les semaines de l'annee donc feuille2 se nomme sem2 feuille3 sem3 etc ..
JE cherche une macro qui m'indique sur la 1ere feuille en celulle E1 E2 E3 (à coté de la liste de noms en fait ) que si le nom est trouvé dans les feuilles 2 à 17 (sem2 à sem17 pour le 1er timestre) la macro mentionne soit le nom de la feuille ou la valeur de la celulle A1.
Cordialement

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Bonjour Laurent, le forum,

Cette version (6) est plus logique et devrait en général être plus rapide.

Formule en E2 G2 I2 :

=OCCUP($A2;D$1)

Formule en D2 F2 H2 :

=NBCAR(E2)-NBCAR(SUBSTITUE(E2;"#";""))

Le code de la fonction est simplifié (2 arguments).

A+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Re,

Eh bien il y avait une erreur pour la date, il fallait écrire :

OCCUP = OCCUP & " #" & F & "!" & ref.Address(0, 0) & "-" _
  & Format(ref.Offset(1 - ref.Row, (1 - ref.Column) Mod 3), "dd/mm/yy")

Version (7).

A+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Bonsoir Laurent, le forum,

La mise à jour de la feuille "Liste" par le bouton ne me satisfaisait pas vraiment.

Voici une solution par macro évènementielle.

La feuille "Liste" est mise à jour chaque fois qu'on modifie des cellules dans les autres feuilles, mais seules les formules concernées sont recalculées.

La macro est dans ThisWorkbook :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
If Sh.Name = "Liste" Then Exit Sub
Dim plage As Range, tablo, adsel$, adsource$, ref As Range, i&
On Error Resume Next
Application.EnableEvents = False
Set plage = Sheets("Liste").Range("A2", Sheets("Liste").[A65536].End(xlUp))
tablo = Application.Transpose(plage)
adsel = Selection.Address
adsource = Range(Source, Source).Address
'---étude de la zone avant modification---
Application.Undo
Set ref = Range(Selection, Selection) 'si sélection multiple
For i = 1 To UBound(tablo)
If Application.CountIf(ref, tablo(i)) Then tablo(i) = ""
Next
'---étude de la zone après modification---
Application.Undo
Range(adsel).Select
For i = 1 To UBound(tablo)
If Application.CountIf(Range(adsource), tablo(i)) Then tablo(i) = ""
Next
'---activation des cellules de la liste pour recalcul des formules---
For i = 1 To UBound(tablo)
  If tablo(i) = "" Then plage.Cells(i) = plage.Cells(i)
Next
Application.OnRepeat "", ""
Application.EnableEvents = True
End Sub

Il y a 3 boucles sur la liste, mais le temps de calcul est tout à fait acceptable.

Version (8) jointe.

A+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Bonjour Laurent, le forum,

Vous avez déjà par inadvertance effacé un nom de la liste ??

Alors c'est la version (9) qu'il vous faut

A+

 

[laurent59]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Merci Job75 c fabuleux ton investissement et surtout ton acharnement !!!
En version excel 2000, rien ne se calcule au contraire d'excel 2003, faut il modifier qqchose ?

Amicalement

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Re,

En version excel 2000, rien ne se calcule au contraire d'excel 2003,

Je n'ai pas Excel 2000, difficile de savoir.

1) Créez un document nouveau et collez-y la macro :

sub a()
Application.Undo
End Sub

Entrez une valeur dans une cellule puis lancez la macro, la valeur est-elle effacée ?

2) Essayez en remplaçant :

If tablo(i) = "" Then plage.Cells(i) = plage.Cells(i)

par :

If tablo(i) = "" Then plage.Cells(i, 1).Value = plage.Cells(i, 1).Value

A part ces 2 points, je ne vois pas, le code est très basique.

A+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Re,

Si le test 2) ne change rien, essayez encore de remplacer la 3ème boucle par :

'---activation des cellules de la liste pour recalcul des formules---
For i = 1 To UBound(tablo)
  If tablo(i) = "" Then
    With plage.Cells(i, 1)
      v = .Value
      .Value = "µ"
      .Value = v
    End With
  End If
Next

Et ajouter v dans les déclarations de variables, en haut.

A+

 

[laurent59]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Job75, désolé pour ce temps de retard je voulais encore te remercier.
J'ai testé la macro en 2000 avec le undo mais la valeur ne s'efface pas quand je l'applique..
Je recherche toujours mais en vain pourquoi le VB ne fonctionne pas sous la version 2000.
@+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Bonjour Laurent,

J'ai testé la macro en 2000 avec le undo mais la valeur ne s'efface pas quand je l'applique..
Je recherche toujours mais en vain pourquoi le VB ne fonctionne pas sous la version 2000.

Si vous avez testé correctement, cela montre que Application.Undo ne fonctionne pas sous Excel 2000.

Il n'y a probablement rien à y faire.

Donc sous Excel 2000 utilisez la version (7) en ajoutant tout de même en début de macro :

If nom = "" Then Exit Function

que j'ai ajouté par sécurité dans la version (9).

A+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Bonjour Laurent, le forum,

Je n'abandonne pas comme ça.

Voici la version (10) qui devrait fonctionner sous Excel 2000, à tester.

En plus elle me paraît meilleure que la version (9), voyez dans ThisWorkbook :

Option Explicit
Option Compare Text 'compare les textes sans tenir compte de la casse
Dim matsel 'mémorise la matrice des valeurs de la plage sélectionnée

Private Sub MemoriseSelection()
On Error Resume Next 'si Selection n'est pas un Range
If ActiveSheet.Name <> "Liste" Then _
  matsel = Intersect(Range(Selection, Selection), ActiveSheet.UsedRange) 'sélection multiple possible
End Sub

Private Sub Workbook_Activate()
MemoriseSelection
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
MemoriseSelection
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
MemoriseSelection
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
If ActiveSheet.Name = "Liste" Then Exit Sub
Dim plage As Range, tablo, m, i&, matsource
Set plage = Sheets("Liste").Range("A2", Sheets("Liste").[A65536].End(xlUp))
tablo = Application.Transpose(plage)
Application.EnableEvents = False
On Error Resume Next
'---étude de la zone avant modification---
For Each m In matsel
  If Err Then m = matsel 'si la matrice n'a qu'un seul élément
  If m <> "" Then
    For i = 1 To UBound(tablo)
      If tablo(i) = m Then plage.Cells(i) = plage.Cells(i) 'recalcul des formules
    Next
  End If
Next
'---étude de la zone après modification---
matsource = Intersect(Range(Source, Source), Sh.UsedRange)
Err = 0
For Each m In matsource
  If Err Then m = matsource
  If m <> "" Then
    For i = 1 To UBound(tablo)
      If tablo(i) = m Then plage.Cells(i) = plage.Cells(i)
    Next
  End If
Next
Application.OnRepeat "", ""
Application.EnableEvents = True
MemoriseSelection
End Sub

A+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Re,

Version (11), j'ai modifié la 1ère macro dans ThisWorkbook :

Private Sub MemoriseSelection()
ActiveCell.Activate 'si la sélection est un objet
matsel = Intersect(Range(Selection, Selection), ActiveSheet.UsedRange) 'sélection multiple possible
End Sub

Edit : zut, j'avais mis un fichier de test, prenez le dernier déposé

A+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Bonjour le fil,

Laurent m'a informé par MP qu'il a toujours des problèmes sur Excel 2000.

De toute façon des choses n'allaient pas dans les versions précédentes.

Tester cette version (12) avec en particulier cette macro :

Private Sub MemoriseSelection()
On Error Resume Next
ActiveCell.Activate 'si la sélection est un objet
matsel = ""
matsel = Intersect(Range(Replace(Selection.Address, ",", ":")), ActiveSheet.UsedRange) 'sélection multiple possible
End Sub

A+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Re,

Avec cette version (13), la fonction OCCUP est réintroduite dans les cellules concernées de la feuille "Liste".

A tester sous Excel 2000, ça fonctionnera peut-être...

A+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Re,

Je viens de modifier les versions (12) et (13).

Dans la Workbook_SheetChange, au lieu de :

If ActiveSheet.Name = "Liste" Then Exit Sub

il faut écrire :

If Sh.Name = "Liste" Then Exit Sub

Et les Application.EnableEvents sont inutiles...

A+

 

[job75]

Re : recherche dans plsueirs feuilles et indique soit nom feuille ou case a1

Bonjour Laurent, le forum,

Je reviens sur ce fil depuis la Normandie.

Sur un ordi avec un vieil Excel 97 je constate que :

- les fonctions Replace et Split ne sont pas acceptées

- la méthode Find ne fonctionne pas.

J'ai donc modifié en conséquence la version (13), avec la fonction OCCUP :

Option Explicit
Option Compare Text

Public Function OCCUP$(nom$, sem$) 'pour Excel 97
Dim i As Byte, F As Worksheet, tablo, u&, col As Byte, lig&, ref As Range
If nom = "" Then Exit Function
For i = Mid(sem, 9, 2) To Right(sem, 2)
  Set F = Sheets(i + 1)
  tablo = F.Range("A1:A2", F.UsedRange) 'pour avoir au moins 2 éléments
  u = UBound(tablo)
  For col = 1 To UBound(tablo, 2)
    For lig = 3 To u
      If tablo(lig, col) = nom Then
        Set ref = F.Cells(lig, col)
        OCCUP = OCCUP & " #" & F.Name & "!" & ref.Address(0, 0) & "-" _
          & Format(ref.Offset(1 - ref.Row, (1 - ref.Column) Mod 3), "dd/mm/yy")
      End If
    Next
  Next
Next
End Function

La fonction utilise un tableau auxiliaire, ce qui la rend plus rapide.

Nota : une chose que je n'ai pas signalée, pour toutes les versions proposées :

Pour qu'une modification d'un nom soit prise en compte, il faut que la cellule du nom fasse partie de la sélection.

Par exemple si l'on supprime la ligne d'un nom sans avoir sélectionné le nom, la modification n'est pas prise en compte.

A+