Ouvrir/modifier puis utiliser un csv
Je souhaite avant de le traiter dans une autre macro ouvrir un fichier CSV supprimer les retour chariot (je les remplace par un /) dans une cellule spécifique puis enregistrer.
Le code ci dessous marche mais ça rame beaucoup beaucoup
Set wbCSV = Workbooks.Open(Filename:=mypath, ReadOnly:=True, Local:=True)
nbLignes = Range("GK1", Selection.End(xlDown)).Cells.Count
For I = 2 To nbLignes
wbCSV.Worksheets(1).Range("GK" & I).Value = Trim(Replace(wbCSV.Worksheets(1).Range("GK" & I).Value, Chr(13) & Chr(10), "/"))
Next I
wbCSV.Save
Derrière je souhaiterais du coup garder le fichier ouvert pour le traiter dans cette macro sans que l'utilisateur ne le vois ouvert .
Set Fe = Worksheets("RecupResult")
If Err.Number <> 0 Then
Set Fe = Sheets.Add(, Worksheets(Worksheets.Count))
Fe.Name = "RecupResult"
Else
Fe.Cells.Clear
End If
On Error GoTo 0 'suppression du gestionnaire d'erreur
'applique une requête sur le fichier
With Fe.QueryTables.Add("TEXT;" & mypath, Fe.Range("A1"))
.TextFileSemicolonDelimiter = True
.TextFilePlatform = 65001
.Refresh 'exécute la requête
.Delete 'supprime la connexion au fichier texte
End With
'défini la plage et applique le filtre avec copie du résultat
'sur la feuille "RecupResult"
With Fe
Set Plage = .Range(.Cells(1, 1), _
.Cells(.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
'Permet de mettre à 0 les filtres si présent
Plage.AutoFilter
'On affiche les lignes non correspondantes au critère puis on supprime en gardant l'entete
Plage.AutoFilter 5, "<>" & Mparti
Plage.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.EntireRow.Delete
' on supprime les filtres pour voir la ligne que l'on veux puis on compte le resultat
Plage.AutoFilter
NbrlResult = Plage.Rows.Count
If NbrlResult <> 2 Then
.Cells.Clear
MsgBox "Participant non trouvé dans la Feuille de résultats " & vbLf & "ou erreur sur l'email " & vbLf & "Pas de résultat QCM", vbCritical, "Importation NOK"
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Exit Sub
End If
T = Plage
.Cells.Clear
For I = 1 To UBound(T, 2)
.Cells(I, 1).Value = T(1, I)
.Cells(I, 2).Value = T(2, I)
'.Cells(I, 3).FormulaLocal = "=NB.SI.ENS(FReponses!I:I;B" & I & ";FReponses!C:C;A" & I & ")"
Next I
End With
l'Origine de mon problème viens de la présence de retours chariot dans mon le CVS que j'importe avec QueryTables.Add , le retourd chariot lui fait sauté passé à la ligne suivant sur la cellule au retours chariot au lieu de continuer.
D’où cette bidouille pour m'en sortir.
En vous remerciant par avance pour votre aide.
Bonjour,
Poste un exemple de ton .csv, comme c'est un fichier texte, peut serait-il plus judicieux de l'ouvrir et le traiter avec "Open for Input" plutôt qu'avec "Workbooks.Open". Précises bien aussi l'endroit où tu penses que ça pose problème.
Ci joint le csv
pour l'instant je m'en sort avec ca
'Suppression des retours chariot qui foute le dawa
Set wbCSV = Workbooks.Open(Filename:=mypath, Local:=True)
nbLignes = Cells.SpecialCells(xlCellTypeLastCell).Row
For I = 2 To nbLignes
wbCSV.Worksheets(1).Range("GK" & I).Replace Chr(13) & Chr(10), "/"
wbCSV.Worksheets(1).Range("LA" & I).Replace Chr(13) & Chr(10), "/"
wbCSV.Worksheets(1).Range("LA" & I).Replace "- ", ""
Next I
'wbCSV.Worksheets(1).Columns("GK").Replace Chr(13) & Chr(10), "/", xlByColumns
'wbCSV.Worksheets(1).Columns("LA").Replace Chr(13) & Chr(10), "/", xlByColumns
'wbCSV.Worksheets(1).Columns("LA").Replace "- ", ""
Application.DisplayAlerts = False
wbCSV.SaveAs Filename:=mypath, FileFormat:=xlCSV, Local:=True
wbCSV.Close
Application.DisplayAlerts = True
Pas vraiment la solution patch provisoire faute de mieux.
Merci pour l'info Open for Input je regarde ca.
Le problème est juste après le .Refresh du query.add , la mise en forme des info récup bug , au niveau de la cellule ou il y a le retours chariot , ca passe une ligne en dessous , du coup derrière lorsque que je récupère les info je n'est que les 193 première réponses, les 121 autres étant sur la ligne du dessous ne sont pas prises.
du coup en supprimant les retours chariot ca pass impec
Le csv
Pour aider à la compréhension , ci joint le fichier CSV à traiter et en exemple le résultat que j'obtiens après le refresh , après la question 193 ça saute une ligne à chaque retours chariot contenu dans la cellule Question
Voici le code que j'utilise pour extraire mes données
With Fe.QueryTables.Add("TEXT;" & mypath, Fe.Range("A1"))
.TextFileSemicolonDelimiter = True
.TextFilePlatform = 65001
.Refresh 'exécute la requête
.Delete 'supprime la connexion au fichier texte
End With
et du coup celui que j'utilise pour patcher faute de mieux
'Suppression des retours chariot qui foute le dawa
Set wbCSV = Workbooks.Open(Filename:=mypath, Local:=True)
nbLignes = Cells.SpecialCells(xlCellTypeLastCell).Row
For I = 2 To nbLignes
wbCSV.Worksheets(1).Range("GK" & I).Replace Chr(13) & Chr(10), "/"
wbCSV.Worksheets(1).Range("LA" & I).Replace Chr(13) & Chr(10), "/"
wbCSV.Worksheets(1).Range("LA" & I).Replace "- ", ""
Next I
Application.DisplayAlerts = False
wbCSV.SaveAs Filename:=mypath, FileFormat:=xlCSV, Local:=True
wbCSV.Close
Application.DisplayAlerts = True
En espérant êtres clair et en vous remerciant par avance pour votre aide.
Bonjour,
Un test de lecture du .csv !
Adapter le chemin et nom dans le code :
Sub LireCSV()
Dim Tbl
Dim Ligne As String
Dim I As Integer
Dim J As Integer
'adapter le chemin et nom du fichier
Open "C:\Users\Delta-Calor\Utilisateur\CSVTEST.csv" For Input As #1
Do While Not EOF(1)
Line Input #1, Ligne
If Ligne <> "" Then
J = J + 1: Tbl = Split(Ligne, ";")
For I = 0 To UBound(Tbl): Cells(J, I + 1) = Tbl(I): Next I
End If
Loop
Close #1
Erase Tbl
End Sub