Colonne excel filtrée vers un bloc note

Question

Bonjour, 

Je suis actuellement en train de travailler sur un fichier excel et je découvre doucement VBA.

J'ai un fichier excel à plus de mille lignes en entrée et en colonne j'ai des appareils pour lesquels j'associe une ligne précise en marquant la ligne d'une croix.

Mon but est d'extraire une colonne précise de mon tableau dans un fichier bloc note. Je commence à comprendre comment écrire cette colonne dans mon bloc note sous VBA mais j'aimerai ajouter un compteur qui permette de s'arréter au bon endroit une fois les cellules filtrées.

Pour exemple mon mini programme ressemble pour le moment à ça :

Sub test()
        Open "C:\...\essai.txt" For Output As #1
                For i = 3 To 2000
                Print #1, Cells(i, 21).Value
                Next i
        Close #1
       
        
End Sub

Mon but est de transformer mon 2000 en une expression du type :
i = 3 to (si colonne A filtrée compter nombre de ligne non vide appartenant à la colonne 21 et me resortir le nombre pour avoir la fin de mon compteur)
puis imprimer cellules

Après avoir parcouru plein de forum je ne trouve pas de réponse c'est pourquoi je me tourne vers vous. J'éspère être assez clair si besoin est je peux précisez d'avantage.
Merci de votre aide

Configuration: Windows XP / Safari 534.30

Utilisateur anonyme · Answer

Bonjour,

Exemple 1 :


Sub test()

    Dim Limite As Long

    Open "C:\...\essai.txt" For Output As #1

    Limite = Range("U65536").End(xlUp).Row

    For i = 3 To Limite
        Print #1, Cells(i, 21).Value
    Next i
    
    Close #1

End Sub
'


Et si vous préféré ne pas avoir le résultat en sortie
avec les lignes du fichier essai.txt entre guillemets,
voici une autre méthode :



Const ctePourLecture = 1
Const ctePourEcrire = 2
Const ctePourAjouter = 8
Const cteRapport = "Essai.txt"

Sub Ecrire()

    Dim Limite As Long

    Dim objFSO As Object, objFichier As Object
    Dim varNomFic As String
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' Localisation du fichier à écrire
    varNomFic = WScript.ScriptFullName
    varNomFic = Left(varNomFic, InStrRev(varNomFic, "\"))
    varNomFic = varNomFic & cteRapport
    
    ' Valide si fichier existe
    If (objFSO.FileExists(varNomFic)) Then
        Set objFichier = objFSO.OpenTextFile(varNomFic, ctePourAjouter)
    Else
        Set objFichier = objFSO.CreateTextFile(varNomFic, ctePourEcrire)
    End If
    
    Limite = Range("U65536").End(xlUp).Row
    
    ' Écrire dans fichier
    For i = 3 To Limite
        objFichier.WriteLine Cells(i, 21).Value
    Next i
    
    objFichier.Close
    
    Set objFichier = Nothing
    Set objFSO = Nothing

End Sub
'


Cdt

Lupin

Utilisateur anonyme · Answer

re:

J'ai effectivement fait une erreur dans le second code :


Option Explicit

Sub Ecrire()

    Dim Limite As Long

    Dim objFSO As Object, objFichier As Object
    Dim varNomFic As String
    
    ' Instancie un objet du système de fichier
    ' (objFSO -> objet File System Object)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' Localisation du fichier à écrire
    ' Prend le nom complet incluant le chemin d'accès du classeur
    varNomFic = ThisWorkbook.FullName
    ' Retire le nom du fichier Excel en conservant le chemin d'accès
    varNomFic = Left(varNomFic, InStrRev(varNomFic, "\"))
    ' Ajoute le nom du fichier de sortie
    varNomFic = varNomFic & cteRapport
    
    ' Valide si fichier existe
    If (objFSO.FileExists(varNomFic)) Then
        ' Si oui, ouvre le pour y ajouter du texte
        Set objFichier = objFSO.OpenTextFile(varNomFic, ctePourAjouter)
    Else
        ' Si non, crée le fichier et ouvre le pour y écrire
        Set objFichier = objFSO.CreateTextFile(varNomFic, ctePourEcrire)
    End If
    
    ' Défini la limite de lecture
    Limite = Range("U65536").End(xlUp).Row
    
    ' Écrire dans fichier
    For i = 3 To Limite
        ' Écrit les valeur dans le fichier
        objFichier.WriteLine Cells(i, 21).Value
    Next i
    
    ' Ferme le fichier
    objFichier.Close
    
    ' Libère les instance en mémoire
    Set objFichier = Nothing
    Set objFSO = Nothing

End Sub
'


Pour l'autre partie de votre problème, qui est en fonction
des colonnes N, O, P, il suffit de les tester dans la boucle :

(N, O, P, colonne 14, 15 et 16)

exemple type :


Sub test()

    Dim Limite As Long

    Open "C:\...\essai.txt" For Output As #1

    Limite = Range("U65536").End(xlUp).Row

    For i = 3 To Limite
        If (Cells(i, 14).Value = "x") Then
            Print #1, Cells(i, 21).Value
        ElseIf (Cells(i, 15).Value = "y") Then
            Print #1, Cells(i, 21).Value
        ElseIf (Cells(i, 16).Value = "z") Then
            Print #1, Cells(i, 21).Value
        End If
    Next i
    
    Close #1

End Sub
'


Cdt

Lupin

Colonne excel filtrée vers un bloc note

2 réponses

Newsletters