Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1502 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Selection multilignes VBA

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Selection multilignes VBA

n°1475637
anat49
Posté le 15-11-2006 à 11:01:44  profilanswer
 

Bonjour à tous, je débute en Excel et j'ai un problème de sélection de plusieurs lignes sous Excel.  
 
Comment fait-on pour sélectionner 500 lignes d'un coup sous Excel?
 
Avec quelques lignes, j'obtiens :  
Range("14:14,16:16,21:21,24:24,26:26" ).Select
 
Mais pour 500 lignes, la commande est trop longue et ça passe plus.
(L'idée serait de stocker les numeros des lignes dans une variable et de tout sélectionner en une commande. Actuellement, mon code est le suivant, mais il est bp trop lent :  
 
For ligne = 2 To 6157
      ' Masquage des lignes
        req_traite = Cells(ligne, 1)
 
        With Worksheets(2).Range("a1:a5292" )
        Set c = .Find(What:=req_traite, LookIn:=xlValues, LookAt:=xlWhole)
         
        If Not c Is Nothing Then
            'Range(ligne).EntireRow.Hidden = True
            Cells(ligne, 1).EntireRow.Select
            Selection.EntireRow.Hidden = True
        End If
        End With
         
    Next
    Application.ScreenUpdating = True
 
 
Merci

mood
Publicité
Posté le 15-11-2006 à 11:01:44  profilanswer
 

n°1475752
kiki29
Posté le 15-11-2006 à 12:27:05  profilanswer
 

A essayer et adapter sans savoir si c'est vraiment plus rapide


Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Sub SelectMultiDiscontinue()
Dim Cellule As Range, Rng As Range
Dim Debut As Long, Fin As Long
 
    Application.ScreenUpdating = False
    Debut = GetTickCount
    'Columns("A:A" ).Select
    Range("A2:A65536" ).select
    For Each Cellule In Selection
        If Cellule.Value <> "" Then
            If Rng Is Nothing Then
                Set Rng = Cellule.EntireRow
            Else
                Set Rng = Union(Rng, Cellule.EntireRow)
            End If
        End If
    Next
     
    Rng.Select
     
    Fin = GetTickCount - Debut
    Application.StatusBar = "Terminé : " & Format(Fin / 1000, "0.0" )
    Application.ScreenUpdating = True
End Sub


Message édité par kiki29 le 15-11-2006 à 13:03:31
n°1475805
anat49
Posté le 15-11-2006 à 14:27:43  profilanswer
 

Merci bp pour la réponse, cela m'a amené en fait un autre véritable pb. En réalité, ce qui prend du temps est la comparaison entre 2 listes de 6000 éléments. Comment faire au plus rapide pour cela? (J'ai l'habitude de faire du Matlab et ça pose pas de pb car il a une puissance de calcul suffisament puissante, mais la, rien qu'une boucle sur 6000 éléments et ça prend au moins 1 min)
 
Mon Code :
 
Private Sub CommandButton1_Click()
 
Dim Rng As Range
    Range("A2:A6157" ).Select
    For Each req_traite In Selection
        If req_traite.Value <> "" Then
            With Worksheets(2).Range("a1:a5292" )
                Set c = .Find(What:=req_traite, LookIn:=xlValues, LookAt:=xlWhole)
         
                If Not c Is Nothing Then
                    If Rng Is Nothing Then
                        Set Rng = req_traite
                    Else
                        Set Rng = Union(Rng, req_traite)
                    End If
                End If
            End With
        End If
    Next
    Rng.Select
    Selection.EntireRow.Hidden = True
 
End Sub

n°1475858
kiki29
Posté le 15-11-2006 à 15:05:43  profilanswer
 

A essayer et adapter  
 
Compare A et B  
Met en C les valeurs de B qui ne sont pas dans  A
 


Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Sub Comparaison2Colonnes()
Dim rA As Range, rB As Range, c As Range
Dim Ligne As Long, Debut As Long, Fin As Long
     
    Application.ScreenUpdating = False
    Debut = GetTickCount
 
    Columns("C:C" ).Clear
     
    Set rA = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
    Set rB = Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp))
     
    Ligne = 1
    For Each c In rB
        If Application.CountIf(rA, c.Value) = 0 Then
            If c.Value <> "" Then
                Cells(Ligne, 3).Value = c.Value
                Ligne = Ligne + 1
            End If
        End If
    Next
     
    Fin = GetTickCount - Debut
    Application.StatusBar = "Terminé : " & Format(Fin / 1000, "0.0" )
    Application.ScreenUpdating = True
End Sub


 
sur un test de 6000 lignes environ 10 s


Message édité par kiki29 le 15-11-2006 à 15:33:27
n°1476527
anat49
Posté le 16-11-2006 à 15:29:31  profilanswer
 

Merci bp, mais j'ai encore un pb.  
 
Dans la feuille 1, j'ai :
 
Set rA = Sheets(1).Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
 
Mais pk je peux pas faire la même chose pour récuperer les données de la première colonne de la feuille 2 avec :
Set rB = Sheets(2).Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
 

n°1476592
kiki29
Posté le 16-11-2006 à 15:57:54  profilanswer
 

   
    Set rA = Sheets(1).Range(Sheets(1).Cells(2, 1), Sheets(1).Cells(Rows.Count, 1).End(xlUp))
    Set rB = Sheets(2).Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(Rows.Count, 1).End(xlUp))


Message édité par kiki29 le 16-11-2006 à 15:58:31
n°1553081
anat49
Posté le 03-05-2007 à 12:33:32  profilanswer
 

Réponse efficace et rapide. Merci


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Selection multilignes VBA

 

Sujets relatifs
[php] Regex sélection d'url[VBA] Word stopper la pagination
[js] bbcode - panel de selection couleur[VBA] Ranger des données a la suite
[Access][VBA] Redimensionner une page Web dans un formulaireVBA : gestion scrollbar sur une frame
lecture doc word sous VBA Access[VB WORD] selection texte entre parenthèse + gras
VBA : information comboboxéquivalent en VBA des macros en C/C++ ?
Plus de sujets relatifs à : Selection multilignes VBA


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR