Bereik opslaan in CSV-bestand
Oplossing #670 voor het exporteren van een bereik naar een tekstbestand met scheidingstekens.
Dit is een handig alternatief voor het gebruik van de standaardmanier van Excel om het werkblad op te slaan als een tekstbestand of CSV-gescheiden bestand door "opslaan als" te kiezen wanneer:
1. U gebruikt een sjabloon en wilt alleen de gegevens exporteren, exclusief headers en andere misc-dingen
2. Op dezelfde manier wil je misschien maar een deel van een dataset exporteren
3. U wilt het bestand opslaan met een aangepast scheidingsteken dat mogelijk uniek is voor uw toepassing.
Als u 1,2 of 3 moet doen, kan een functie zoals de volgende helpen. Het accepteert een bereik om te exporteren, de locatie om het bestand op te slaan en het scheidingsteken waarmee u uw gegevens wilt scheiden, en slaat vervolgens uw gegevens op zoals gespecificeerd.
Zo roept u de functie op ExportBereik:
| 1234567891011 | Sub OproepExport()'ExportBereik(bereik,waar,scheidingsteken)Roep ExportRange(Blad1.Range("A1:C20"), _"C:mark.txt", ",")Einde sub |
Eerst vertel je de functie het bereik dat je wilt exporteren, dan waar je het moet exporteren, dan het scheidingsteken dat moet worden gebruikt. Je hebt ook de functie nodig ExportBereik, hier is het:
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263 | Functie ExportRange (WhatRange As Range, _Waar als string, scheidingsteken als string) als stringDim HoldRow As Long 'test voor nieuwe rijvariabele'HoldRow = WhatRange.RowDim c As Range 'loop door bereikvariabele'Voor elke c in WhatRangeAls HoldRow c.Row dan'voeg regeleinde toe en verwijder extra scheidingsteken'ExportBereik = Links (ExportBereik, Len (ExportBereik) - 1) _& vbCrLf & c.Tekst & scheidingstekenHoldRow = c.RijAndersExportRange = ExportRange & c.Text & scheidingstekenStop alsvolgende c'Extra scheidingsteken bijsnijden'ExportBereik = Links (ExportBereik, Len (ExportBereik) - 1)'Dood het bestand als het al bestaat'Als Len(Dir(Waar)) > 0 DanDood waarStop alsOpen Where For Append As #1 'schrijf het nieuwe bestand'Afdrukken #1, ExportbereikSluiten #1Functie beëindigen |
