Cel bereik exporteren.

[TonLindemann]

Hallo,

Lange tijd heb ik Quattro Pro gebuikt van WordPerfect, vanwege enkele kunstjes die ik in Excel niet kan vinden. Het gaat daarbij om het selecteren van een celbereik, of rijen of kolommen en dat te exporteren als een .txt bestand met veldscheidingstekens (tab), waarbij overtollige lege rijen of kolommen of lege cellen aan het einde van het gegevensbereik in rijen of kolommen niet worden meegenomen. In Quattro Pro kon ik deze actie handmatig of met een via een macrorecorder opgenomen macro uitvoeren.
Nu draait deze antieke Quattro Pro in een virtuele omgeving onder Win 2000, maar niet van harte. Hij crashed regelmatig in die virtuele omgeving en ik moet nu op zoek naar een andere oplossing. Onder Win 7 en 8.1 werkt deze editie helemaal niet meer.
De data moet uiteindelijk naar Access van Office 2003 die op de VM wel goed draait. Rechtstreeks importeren vanuit Excel 2003 is geen succes gebleken. We gebruiken op de host met Win 8.1 MS Office 2013.
Ook het alternatief voor M$, Open Office, heeft deze optie niet in huis en met een Engelstalige editie van Corel Office (WP en QP) is het toch soms lastig werken.
Heeft iemand een suggestie hoe dit gedaan kan worden met al of niet een macro in Excel 2003 en/of 2013? Zij macro's terug te converteren van Excel 2013 naar Excel 2003?

Dank voor de moeite.

 

[edmoor]

Het is geen enkel probleem om daar een macro voor te maken. Als je een voorbeeld document plaatst wil ik dat wel voor je doen.

 

[TonLindemann]

Dank alvast voor het aanbod. Ik ga eerst even een oud test-excelletje uit 2006 aanpassen en bij de tijd brengen en zal daarna het een en ander met een toelichting uploaden.

 

[edmoor]

So...



Right?

 

[TonLindemann]

Bekijk bijlage Meteo_Maarssen_VP.xls

Hallo,

Bijgaande de verzoeken voor het bijgaande Excel-bestand om celbereiken te exporteren naar <tab>-gescheiden .txt bestanden. Het spreadsheet, (Excel 2003 bewerkt in 2013) is ingevuld met een aantal dummie waarden. Ik hoop dat ik niet teveel vraag, anders zijn een paar voorbeelden waar ik één en ander zelf kan aanpassen ook goed.

Met dank voor alle hulp alvast.

Ton Lindemann

==============

In één macro:
Celbereik Transfer A2:AM3 => D:\PcLink4\MM\T.txt
Celbereik Transfer A6:AD7 => D:\PcLink4\MM\R18.txt
Celbereik Transfer A10:T11 => D:\PcLink4\MM\R23.txt
Celbereik Transfer A14:V15 => D:\PcLink4\MM\B.txt
Celbereik Transfer A18:O19 => D:\PcLink4\MM\S.txt
Celbereik Transfer A22:AA23 => D:\PcLink4\MM\L.txt
Celbereik Transfer A26:I27 => D:\PcLink4\MM\Z.txt
Celbereik Transfer A30:I31 => D:\PcLink4\MM\W.txt
Celbereik Sneeuw A2:BK3 => D:\Pclink4\MM\S1.txt
Celbereik Onweer A2:Q3 => D:\Pclink4\MM\O.txt
Celbereik MAS A501:K646 => D:\Pclink4\MM\U.txt

In één macro:
Celbereik MAS A2:AM12 => D:\PcLink4\MM\T.txt
Celbereik MAS A22:AD32 => D:\PcLink4\MM\R18.txt
Celbereik MAS A42:T52 => D:\PcLink4\MM\R23.txt
Celbereik MAS A62:V72 => D:\PcLink4\MM\B.txt
Celbereik MAS A82:O92 => D:\PcLink4\MM\S.txt
Celbereik MAS A102:AA112 => D:\PcLink4\MM\L.txt
Celbereik MAS A122:I132 => D:\PcLink4\MM\Z.txt
Celbereik MAS A142:I152 => D:\PcLink4\MM\W.txt

Voor beide macro's geldt indien mogelijk geen waarschuwingen voor overschrijvingen bij opslaan.

Aanvullende vraag:
De veldwaarden in tab <Complementair ss - ss07 - ss19 - S4-07 -S4-19> behoren overal een '.' (punt) te zijn. Dat wordt gekopieerd naar regel 19 in transfer. Maar dan werken tevens de formules in de cellen niet meer. Omdat de waarde '0' (nul) ook een echte waarde kan zijn moet deze op een punt blijven staan als er niets wordt ingevuld en moeten de formules bij ingevulde waarden toch werken. Hetzelfde doet zich ook voor bij het tab <sneeuw ss07 en ss19>. Quattro Pro had hier geen moeite mee. Hoe doe ik dat in Excel?

 

[edmoor]

Wat betreft het exporteren naar CSV, bij deze een voorbeeld voor de eerste, dus A2 t/m AM3. De rest kun je dan zelf wel invullen denk ik:

Sub ExportCSV1()
    Dim CSV1 As Integer
    
    CSV1 = FreeFile()
    
    Open "D:\PcLink4\MM\T.txt" For Output As CSV1
    For i = 2 To 3
        For Each cel In Range("A" & i & ":AM" & i)
            If cel.Column < Range("A" & i & ":AM" & i).Cells.Count Then
                Print #CSV1, cel & vbTab;
            Else
                Print #CSV1, cel
            End If
        Next
    Next i
    
    Close CSV1
End Sub

Je aanvullende vraag begrijp ik niet helemaal. Misschien dat je daar wat extra uitleg over kunt geven?

Wel even een compliment voor je uitgebreide voorbeeld :thumb:

 

[TonLindemann]

Beste ??;

Dank voor de snelle service! Ik ben wel geen programmeur maar begrijp er voldoende van om zelf wat te gaan stoeien. Even voor de zekerheid. Moet ik binnen één macro alles binnen een enkele sub - end sub zetten, of kun je telkens opnieuw beginnen met sub - end sub? Dus:

sub
regels voor eerste extract
regels voor tweede extract
end sub

of

sub
regels voor eerste extract
end sub
sub
regels voor tweede extract
end sub

Op het tweede probleem kom ik later terug.

Dank nogmaals,

Ton.

 

[edmoor]

Als je de eerste ? vervangt door een E en de tweede door een d kom je aardig in de richting

On topic:
Die eerste macro hoef je alleen maar uit te breiden. Het hele verhaal blijft dus tussen de bestaande Sub en End Sub vallen. Mocht je ergens niet uitkomen Dan zien we je hier wel terug

 

[TonLindemann]

OK Ed;

Helaas loop ik tegen een klein probleempje op. Ik heb gevonden hoe je meerdere extracten in een macro stopt. Maar bovenstaand voorbeeld vist hem op van het eerst geopende tabblad wat hij tegenkomt in de spreadsheet. Hoe maak ik hem zo wijs dat die van het goede tabblad, bv <transfer>, gebruik maakt?

Dank alweer,

Ton.

 

[edmoor]

Op deze manier:

Sub ExportCSV1()
    Dim CSV1 As Integer
    
    CSV1 = FreeFile()
    
    Open "D:\PcLink4\MM\T.txt" For Output As CSV1
    For i = 2 To 3
        For Each cel In Sheets("Transfer").Range("A" & i & ":AM" & i)
            If cel.Column < Sheets("Transfer").Range("A" & i & ":AM" & i).Cells.Count Then
                Print #CSV1, cel & vbTab;
            Else
                Print #CSV1, cel
            End If
        Next
    Next i
    
    Close CSV1
End Sub