Új hozzászólás Aktív témák

• #20947 Mutt senior tag Oly #20889

  Új Válasz 2014-03-15 20:45:46 #20947

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz Oly #20889 üzenetére

  Hello,

  Nem aktuális már, de ezért még jól jöhet.

  Sub CreateCsv()
  Const sorok = 2000 'ennyi soronként szabdalunk
  Const utvonal = "c:\Temp\" 'ide mentunk
  Dim FileNum As Integer
  Dim DestFile As String
  Dim vLastRow As Long
  Dim c As Long, i As Long, j As Long
  Dim ki As String
  Const sep = ";" 'a mezők ezzel lesznek elválasztva
  Dim formatum As String
  
  'megnézzük hány sorunk van
  vLastRow = Range("A" & Rows.Count).End(xlUp).Row
  'egy kis csinosítás a fájlban lévő sorszámra, pl. 1 helyett 01-et írunk majd
  formatum = String(Len(WorksheetFunction.RoundUp(vLastRow / sorok, 0) & ""), "0")
  'változó hogy tudjuk hanyadik fájlt írjuk
  c = 1
  'változó hogy tudjuk melyik sorban vagyunk
  i = 1
  
  Do
  DestFile = utvonal & "test" & Format(c, formatum) & ".csv"
  FileNum = FreeFile()
  'megnyitjuk írásra a fájlt
  Open DestFile For Output As #FileNum
  Do While i <= sorok * c And i <= vLastRow
  'betesszük egy változóba az aktuális sor celláit, a cellák közé a tagolójelet beszúrjuk
  ki = ""
  For j = 1 To Cells(i, Columns.Count).End(xlToLeft).Column
  ki = ki & Cells(i, j) & sep
  Next j
  'fájlba tesszük a sor tartalmát tagolójellel
  Print #FileNum, Left(ki, Len(ki) - Len(sep))
  'következő sorra ugrunk
  i = i + 1
  Loop
  'bezárjuk a fájlt
  Close FileNum
  i = sorok * c + 1
  'új fájlra van szükség
  c = c + 1
  Loop While i <= vLastRow '
  
  End Sub

  üdv

Új hozzászólás Aktív témák