XL 2021 Affichage automatique

[nka]

Bonjour à tous,
Je voudrais faire afficher sur un autre onglet les zones qui sont oranges dans les 2 exemples des onglets du fichier ci-joint.
Ce fichier est un exemple d'extraction automatique sur plusieurs sites.
Donc des fois cette zone en orange se situe entre les cellules L3 et T3, d'autres fois entre I3 et N3 etc.
Il me faudrait une formule qui repère d'une façon la position de ces cellules.
J'espère être clair, ce n'est décidément pas facile d'expliquer ce que l'on veut .
Merci d'avance,
nka

 

[job75]

Bonjour nka, le forum,

Il me faudrait une formule qui repère d'une façon la position de ces cellules.

Vous pouvez par exemple entrer cette formule en E1 :

=ADRESSE(3;EQUIV("*Virtuel*";3:3;0);4)

Elle donne l'adresse de la 1ère cellule contenant le mot "Virtuel".

A+

 

[job75]

Et si l'on veut l'adresse de la plage "Virtuel" :

=ADRESSE(3;EQUIV("*Virtuel*";3:3;0);4)&":"&ADRESSE(3;EQUIV("zzz";3:3);4)

 

[nka]

Et comment obtenir l'affichage de ces "Pluvio Virtuels" sur une autre feuille ?

 

[job75]

Utilisez une macro pour copier la plage que vous avez repérée en E1.

 

[job75]

La macro affectée aux boutons est très simple :

Sub Copier()
With Sheets("Virtuel")
    .Cells.Delete 'RAZ
    On Error Resume Next
    Range([E1]).EntireColumn.Copy .[A1]
    .Activate
End With
End Sub

 

[nka]

Waw une macro ! Merci !
Encore un question :
Je voudrais pouvoir faire les sommes des chiffres entre L5 et T25 par heure et par pluvio virtuel. Et évidemment je ne sais pas en quelle position ils sont à l'avance (comme pour le titre).

 

[job75]

Je voudrais pouvoir faire les sommes des chiffres entre L5 et T25 par heure et par pluvio virtuel.

C'est un peu compliqué, vous aurez peut-être du mal à comprendre, désolé :

Sub Copier()
Dim P As Range
With Sheets("Virtuel")
    .UsedRange.EntireColumn.Delete 'RAZ
    On Error Resume Next
    Range([E1]).EntireColumn.Copy .[A1]
    Set P = .UsedRange.Columns(1).SpecialCells(xlCellTypeConstants, 1)
    Set P = Intersect(P.EntireRow, .Cells.SpecialCells(xlCellTypeLastCell).EntireColumn).Offset(, 1)
    P(0) = "Total"
    P = "=SUM(RC2:RC[-1])"
    P.EntireColumn.HorizontalAlignment = xlCenter 'centrage
    P.EntireColumn.Font.Bold = True 'gras
    .Activate
End With
End Sub

 

[nka]

Merci Job pour le gros boulot !
Mais n'y aurait-il pas moyen de n'utiliser que des fonctions EXCEL ? Par exemple une conjonction de SOMME.SI.ENS, EQUIV et INDEX ?

 

[job75]

Bonjour nka, le forum,

Je pense que sans VBA il est quasiment impossible de réaliser ce que j'ai fait.

A+

 

[nka]

Ah dommage !
OK repassons sur la macro alors.
Je me suis mal exprimé sur ce dont j'ai besoin :
Je voudrais la somme des données sur entre 11h et 12h puis la somme des données entre 12 et 13h etc.
et ce pour chaque pluvio.
A la fin on aurait un résultat du style du 2ème onglet de la pj.
Ne pas prendre en compte l'affichage en colonne A : seul m'intéresse l'agrégation sur une colonne dynamique.

 

[job75]

C'est trop compliqué, je passe la main.

 

[job75]

Je reviens avec une solution finalement assez simple :

Sub Copier()
Dim i&
Application.ScreenUpdating = False
With Sheets("Virtuel")
    .Cells.Delete 'RAZ
    On Error Resume Next
    Range([E1]).EntireColumn.Copy .[A1]
    With .Columns(1).SpecialCells(xlCellTypeConstants, 1).EntireRow
        .Sort .Columns(1), xlAscending, Header:=xlNo 'tri sur les dates/heures
        For i = .Rows.Count To 2 Step -1
            .Cells(i, 1) = CDate(Format(.Cells(i, 1), "dd/mm/yyyy hh:00")) 'arrondi à l'heure
            .Cells(i - 1, 1) = CDate(Format(.Cells(i - 1, 1), "dd/mm/yyyy hh:00")) 'arrondi à l'heure
            If .Cells(i, 1) = .Cells(i - 1, 1) Then
                .Cells(i, 1) = ""
                .Rows(i).Copy 'copier
                .Rows(i - 1).PasteSpecial xlPasteValues, Operation:=xlAdd 'collage spécial avec addition
                .Rows(i).Delete 'supprime la ligne
            End If
        Next i
        For i = 1 To .Rows.Count
            .Cells(i, 1) = Format(.Cells(i, 1), "dd/mm/yyyy hh\h") & Format(Hour(.Cells(i, 1)) + 1, " à 00\h")
        Next i
        .Columns(1).AutoFit 'ajustement largeur
    End With
    Application.Goto .[A1], True 'cadrage
End With
End Sub

 

[job75]

Bonjour nka, le forum,

Pour tester j'ai recopié le tableau source K5:T25 sur "seulement" 2100 lignes.

La macro précédente s'exécute chez moi en 16,5 secondes.

Pour aller vite il faut utiliser une autre méthode, avec un tableau VBA :

Sub Copier()
Dim tablo, ncol%, n&, i&, j%
With Sheets("Virtuel")
    .Cells.Delete 'RAZ
    On Error Resume Next
    Range([E1]).EntireColumn.Copy .[A1]
    With .Columns(1).SpecialCells(xlCellTypeConstants, 1).Resize(, .UsedRange.Columns.Count)
        .Sort .Columns(1), xlAscending, Header:=xlNo 'tri sur les dates/heures
        tablo = .Value 'matrice, plus rapide
        ncol = UBound(tablo, 2)
        tablo(1, 1) = CDate(Format(tablo(1, 1), "dd/mm/yyyy hh:00")) 'arrondi à l'heure
        n = 1
        For i = 2 To UBound(tablo)
            tablo(i, 1) = CDate(Format(tablo(i, 1), "dd/mm/yyyy hh:00")) 'arrondi à l'heure
            If tablo(i, 1) = tablo(n, 1) Then
                For j = 2 To ncol: tablo(n, j) = tablo(n, j) + tablo(i, j): Next j 'additionne les valeurs
            Else
                n = n + 1
                For j = 1 To ncol: tablo(n, j) = tablo(i, j): Next j 'copie toute la ligne
            End If
        Next i
        For i = 1 To n
            tablo(i, 1) = Format(tablo(i, 1), "dd/mm/yyyy hh\h") & Format(Hour(tablo(i, 1)) + 1, " à 00\h")
        Next i
        .Resize(n) = tablo 'restitution
        .Offset(n).Resize(.Rows.Count - n).Delete xlUp 'RAZ en dessous
    End With
    .UsedRange.Columns(1).AutoFit 'actualise les barres de défilement et ajuste la largeur de colonne
    Application.Goto .[A1], True 'cadrage
End With
End Sub

Sur 2100 lignes cette macro s'exécute en 0,03 seconde.

A+