copia se contiene piu caratteri

Hai un problema con Excel?

Nuova discussione

copia se contiene piu caratteri
di almanegrita (utente non iscritto) data: 09/07/2017 08:57:37
ciao a tutti.
Ho una routine che mi prende i valori dalla colonna A e me li copia in un altro foglio e salva lo stesso su hard disk.
Avrei la necessita di copiare gli stessi valori se e solo se nella colonna ci sono piu di 20 caratteri.
La routine che uso è in basso.
Grazie mille a tutti voi.
ESEMPIO
------------------------------------------------
Colonna A
Revise;161859877317;1000;29 ok
Revise;161859877341;1000;29 ok
Revise;152427703922;1000;1 ok
Revise;0;1000;0 non copiare
Revise;0;1000;0 non copiare
Revise;0;1000;0

    Application.ScreenUpdating = False
    Sheets("sincronia_xxxx").Select
    Range("A1:A6450").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:= _
    "E:LAVOROXXXXGIACENZEsincronia.csv" _
    , FileFormat:=xlCSV, CreateBackup:=False
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Sheets("Gestione_inventario_xxxx").Select
     
     
     End Sub

di Vecchio Frac data: 09/07/2017 09:44:05
Una soluzione veloce al volo, con le regex.
Il concetto è comunque ciclare sulle celle interessate e vedere se la lunghezza della singola cella è maggiore di 20 caratteri. Senza sccomodare le regex, potresti farlo tranquillamente anche con un test su Len(cel)>20.

Option Explicit

Sub test()
Dim re As Object, cel As Range
Dim wbk1 As Workbook, wbk2 As Workbook
Dim i As Long

    Set re = CreateObject("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = False        'ignore case
    re.Pattern = "(.{20})+"
    
    Application.ScreenUpdating = False
    
    Set wbk1 = ThisWorkbook
    Set wbk2 = Workbooks.Add
    
    For Each cel In wbk1.Sheets("foglio1").Range("A1:A6450")
        If re.test(cel) Then
            i = i + 1
            cel.Copy wbk2.Sheets("foglio1").Cells(i, "A")
        End If
    Next
    
    wbk2.SaveAs Filename:="sincronia.csv", FileFormat:=xlCSV, CreateBackup:=False
    Application.DisplayAlerts = False
    wbk2.Close
    Sheets("foglio1").Select

End Sub

di Vecchio Frac data: 09/07/2017 12:19:34
Una variante, ben più performante :)

Option Explicit

Sub test()
Dim cel As Range
Dim f As String
Dim i As Long

    Sheets("Foglio1").Select
    i = FreeFile
    Open "sincronia.csv" For Output As i
    For Each cel In Range("A1..A6450")
        If Len(cel) > 20 Then Print #i, cel
    Next
    Close

End Sub

di Vecchio Frac data: 09/07/2017 16:23:33
Un'altra soluzione, valida per imparare a smanettare con ADO.
Probabilmente per un numero di righe alto è anche più veloce...
L'esempio riporta in D i dati della tabella che si trova in A, filtrata per i soli valori più lunghi di 20 caratteri.

Sub test_with_ADO()
Dim cn As Object
Dim rs As Object
Dim sConn As String
Dim sql As String

    sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName _
        & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
    
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    cn.Open sConn

    sql = "SELECT * FROM [$A1:A15] WHERE Len([F1])>20" ''Range
    
    rs.Open sql, cn
    
    Range("D1:D100").ClearContents
    Range("D1").CopyFromRecordset rs
    rs.Close
    cn.Close
End Sub

di almanegrita (utente non iscritto) data: 09/07/2017 18:16:39
grazie per l'aiuto.
Ho allegato un file cosi capite meglio.
Nella colonna Q ci sono i dati che devo mettere in un file csv e caricare nel gestionale.
Dato che il gestionale non digerisce alcuni caratteri ho deciso di chiedere questa cosa a voi piu esperti.
Praticamente io dovrei prendere tutte le celle della colonna Q che hanno piu di 20 caratteri, e salvarle in un file csv.
Adesso, ogni volta le filtro con excel, poi le copio e le salvo in un file ti testo, lo rinomino......etc etc.....ma volevo fare una cosa piu rapida con vba.
Ho provato ad inplementare ma non funge.

di Vecchio Frac data: 09/07/2017 21:44:25
Ti chiederei come hai provato ad implementare... funge, ovviamente con la necessaria correzione per tener conto delle celle con valore di errore ^_^
(questo perchè a inizio discussione si dovrebbero dare tutte le informazioni sul file: è per questo che spesso si chiede una copia, per lavorare sullo scenario reale)

La correzione è semplice (prendo il codice più breve che ho scritto oggi).

Option Explicit

Sub test()
Dim cel As Range
Dim f As String
Dim i As Long

    Sheets("Foglio1").Select
    i = FreeFile
    Open "sincronia.csv" For Output As i
    For Each cel In Range("Q1..Q15000")
        If Not IsError(cel) Then
            If Len(cel) > 20 Then Print #i, cel
        End If
    Next
    Close

End Sub

di almanegrita (utente non iscritto) data: 10/07/2017 06:43:20
ecco, li ho messi in una cartella sia il file excel che il file sincronia.csv, ma il file csv non viene sovrascritto con i valori esatti.

Sub test()
Application.ScreenUpdating = False
fpath = ThisWorkbook.Path & ""

Dim cel As Range
Dim f As String
Dim i As Long

    Sheets("Foglio1").Select
    i = FreeFile
    Open "sincronia.csv" For Output As i
    For Each cel In Range("Q1:Q15000")
        If Not IsError(cel) Then
            If Len(cel) > 20 Then Print #i, cel
        End If
    Next
    Close

End Sub

di Vecchio Frac data: 10/07/2017 08:48:08
Bene, "il file csv non viene sovrascritto con i valori esatti" perchè non stai sovrascrivendo il file csv...
Facciamo così, prima di dirti come dovrebbe essere, riesci a commentarlo riga per riga? vedrai che ti salterà subito all'occhio qual è il punto critico :)
di almanegrita (utente non iscritto) data: 10/07/2017 10:24:29
ciao ,adesso mi da errore nel path.
ma credo di aver messo esattamente il path del file.
di Vecchio Frac data: 10/07/2017 11:19:35
Dovresti dire quale errore. Scommetto che è perchè non hai dichiarato la variabile (certo però che il path deve esistere) ^_^
E poi guarda bene il tuo codice. Hai fatto riferimento correttamente al path? dappertutto?
di almanegrita (utente non iscritto) data: 10/07/2017 15:58:41
ragazzi sto impazzendo...il caldo mi ha fuso il cervello.
Avevo pensato di usare anche CreateObject("scripting.filesystemobject").createtextfile(ThisWorkbook.Path & "giacenza.csv").Write
che avevo correttamente su un altro modulo ma non riesco a modificarla..
booh...ho proprio il prosciutto sugli occhi.

di Vecchio Frac data: 10/07/2017 16:02:38
Eppure a me sembrava accessibile ^_^

Sub test()
Dim cel As Range
Dim i As Long

    Sheets("Foglio1").Select
    i = FreeFile
    Open ThisWorkbook.Path & "sincronia.csv" For Output As i    '<<<<<
    For Each cel In Range("Q1:Q15000")
        If Not IsError(cel) Then
            If Len(cel) > 20 Then Print #i, cel
        End If
    Next
    Close

End Sub

di almanegrita (utente non iscritto) data: 10/07/2017 16:05:26
è accessibile certo......sono io che sono pirla..madonna che fesseria era.....
Grazie per la vostra pazienza infinita.

Vuoi Approfondire?