Sélectionnez la première filtrée de cellules, puis passer à la prochaine filtrée de cellules vers le bas

J'ai une feuille de calcul Excel qui dispose d'un contact, par exemple:

    A                 B            C            D                    E
1   Select who you would to like to email:      * Drop down list *
2   Name:            Company:      Role:        Email Address1:      Email Address2:
3   Michael Jackson  Jackson 5     Singer       MJ@J5.com            Michael@J5.com
4   Brian May        Queen         Guitarist    BM@Queen.com         Brian@Queen.com
5   Kurt Cobain      Nirvana       Singer       KC@Nirvana.com       Kurt@Nirvana.com
6   Freddie Mercury  Queen         Singer       FM@Queen.co.uk       Freddie@Queen.com
7   Pat Smear        Nirvana       Guitarist    PS@Foo.com           Pat@Foo.com

Un utilisateur sélectionne une adresse e-mail à l'aide de la liste déroulante de D1 puis exécute une macro qui reçoit l'e-mail les adresses dans la colonne.

Le problème est que lorsqu'un utilisateur applique un filtre, dire tous les guitaristes, il est sélectionné pour la première filtré ligne (C4) et puis aller à la ligne suivante, plutôt que la prochaine filtré ligne, de sorte qu'il serait aller à C5.

C'est une adaptation du code:

Sub SendEmail()

Dim objOutlook As Object
Dim objMail As Object
Dim RowsCount As Integer
Dim Index As Integer
Dim Recipients As String
Dim Category As String
Dim CellReference As Integer

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

RowsCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1

Category = Range("D1")
Dim RowLimit As String
If Category = "Email Address1" Then
    CellReference = 4
ElseIf Category = "Email Address2" Then
    CellReference = 5
End If

Index = 0
While Index < RowsCount
    Set EmailAdrs = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, CellReference).Offset(0 + Index, 0)
    Recipients = Recipients & EmailAdrs.Value & ";"
    Index = Index + 1
Wend

 With objMail
    .To = Recipients
    .Subject = "This is the subject"
    .Display
End With

Set objOutlook = Nothing
Set objMail = Nothing

End Sub

J'ai essayé une boucle sur les lignes qui sont cachés:

While Index < RowsCount
   Do While Rows(ActiveCell.Row).Hidden = True
       'ActiveCell.Offset(1).Select
       Set EmailAdrs = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, CellReference).Offset(0 + Index, 0)
        Recipients = Recipients & EmailAdrs.Value & ";"
        Index = Index + 1
        ActiveCell = ActiveCell.Offset(0 + Index, 0).Select
    Loop
Wend

J'ai essayé d'aller dans les cellules qui sont visibles.

J'ai essayé idées de VBA Aller à la prochaine filtrée de cellules:

If ActiveSheet.FilterMode = True Then
    With ActiveSheet.AutoFilter.Range
        For Each a In .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible).Areas
            Recipients = Recipients & a(1, CellReference) & ";"
        Next
    End With
    MsgBox Replace(Recipients, ";;", vbNullString)
End If

Et:

Dim Rng As Range
If Category = Range("S2") Then
    CellReference = 10
    'Set your range
    Set Rng = Range("A1:B2")
ElseIf Category = Range("S3") Then
    CellReference = 14
    'Set your range
    Set Rng = Range("C1:D2")
ElseIf Category = Range("S4") Then
    CellReference = 18
    'Set your range
    Set Rng = Range("F1:G2")
ElseIf Category = Range("S5") Then
    CellReference = 16
    'Set your range
    Set Rng = Range("H1:J2")
End If

For Each mCell In ThisWorkbook.Sheets("YourSheetName").Range(Rng).SpecialCells(xlCellTypeVisible)
    'Get cell address
    mAddr = mCell.Address
    'Get the address of the cell on the column you need
    NewCellAddr = mCell.Offset(0, ColumnsOffset).Address
    'Do everything you need
Next mCell

InformationsquelleAutor Ben Smith | 2015-07-24

Essayez ce code:

Sub SendEmail()
Dim objOutlook As Object
Dim objMail As Object
'Dim RowsCount As Integer
'Dim Index As Integer
Dim Recipients As String
Dim Category As String
Dim CellReference As Integer
Dim RowLimit As String
'New variables.
Dim firstRow As Long
Dim lastRow As Long
Dim cell As Excel.Range
Dim row As Long
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
Category = Range("D1")
If Category = "Email Address1" Then
CellReference = 4
ElseIf Category = "Email Address2" Then
CellReference = 5
End If
With ActiveSheet
'Find the first and last index of the visible range.
firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).row
lastRow = .Cells(.Rows.Count, 1).End(xlUp).row
'Iterate through all the rows between [firstRow] and [lastRow] established before.
'Some of those rows are hidden, but we will check it inside this loop.
For row = firstRow To lastRow
Set cell = .Cells(row, CellReference)
'We are checking here if this row is hidden or visible.
'Note that we cannot check the value of property Hidden of a single cell,
'since it will generate Run-time error '1004' because a single cell cannot be
'hidden/visible - only a whole row/column can be hidden/visible.
'That is why we need to refer to its .EntireRow property first and after that we
'can check its .Hidden property.
If Not cell.EntireRow.Hidden Then
'If the row where [cell] is placed is not hidden, we append the value of [cell]
'to variable Recipients.
Recipients = Recipients & cell.Value & ";"
End If
Next row
End With
With objMail
.To = Recipients
.Subject = "This is the subject"
.Display
End With
Set objOutlook = Nothing
Set objMail = Nothing
End Sub

Qui fonctionne parfaitement! Merci!!!! J'apprécie que vous avez passé du temps à écrire ce code, mais pourriez-vous expliquer pour moi afin que je puisse bien comprendre ce qu'il se passe
J'ai ajouté quelques commentaires supplémentaires à ce code pour mieux comprendre. Si vous avez encore plus de questions, faites le moi savoir dans les commentaires.
Je me rends compte, de grandes feuilles (plus de 10.000 lignes), la boucle for est très coûteuse en temps. Connaissez-vous une alternative efficace pour cela?

InformationsquelleAutor mielk

2

Je crois que le Hidden propriété d'une gamme est ce que vous voulez. Le code suivant a fonctionné pour moi:
```
Dim row As Range
For Each row In Range("MyTable").Rows
If not row.EntireRow.Hidden Then
''' DO STUFF '''
End If
Next
```
J'ai toujours trouvé que l'utilisation d'un For Each boucle est beaucoup plus propre façon de parcourir les données dans une feuille excel. "Matable" était le nom que j'ai donné à la gamme de l'intérêt, mais si vous le préférez, vous pouvez simplement entrer une des limites de la gamme comme Range("A1:D4"). Bien que je pense qu'il est préférable d'utiliser des plages nommées, car il rend votre code plus lisible.

EDIT: pour répondre À votre commentaire...

Si vous insérez une ligne dans le milieu d'une plage nommée les limites de la plage de développer automatiquement. Bien que si votre table est le seul de données dans la feuille de calcul vous pouvez également utiliser le UsedRange propriété d'un objet de feuille de calcul. Par exemple:
```
Dim row As Range
For Each row In Worksheets("MySheet").UsedRange.Rows
If not row.EntireRow.Hidden Then
''' DO STUFF '''
End If
Next
```
Si tout ce que vous avez est la première ligne de la table, vous pouvez étendre cette gamme à l'intégralité de la table à l'aide de:
```
dim FirstRow as Range
dim LastRow as Range
dim myTable as Range
set FirstRow = Range("A1:B1")
set LastRow = FirstRow.End(xlDown)
set myTable = Range(FirstRow, LastRow)
```
Et ensuite utiliser le même For Each boucle comme avant. Espérons que cette aide!
- Veuillez noter que la plage peut changer, un jour, il pourrait y avoir 150 lignes et d'autres, il pourrait 168 lignes, de sorte qu'il peut aller vers le haut ou vers le bas; est-ce que votre code fonctionne encore?
- Reportez-vous à mon montage pour plus de verbosité. Pour résumer, soit utiliser UsedRange ou de développer une ligne unique pour l'ensemble de données à l'aide de la End méthode de Range objet.
InformationsquelleAutor Michael S Priz
0

Pour tout intéressé par cette solution, j'ai réalisé que c'est beaucoup plus rapide pour tester la logique du filtre dans la valeur de la cellule, au lieu de vérifier si le filtre a la colonne cachée ou pas (dans les feuilles avec plus de 10 000 lignes), donc ne nécessitant pas de sélectionner une ligne entière à chaque fois, juste une seule cellule.

Bien sûr, vous avez besoin de savoir à l'avance l'expression pour le filtre, ce qui n'est pas traitée dans le présent code.

Par exemple, si le filtre de test des valeurs inférieures à 0,5, il est préférable d'essayer:
```
Range("U1").Select 'The column where the filter is being applied
ActiveCell.Offset(1, 0).Select
Do Until CDbl(ActiveCell.Formula) < 0.5 'The condition applied in the filter
ActiveCell.Offset(1, 0).Select
Loop
```
InformationsquelleAutor Brethlosze

Vous devez vous connecter pour publier un commentaire.