excel - Export selected rows and columns to CSV-file -
i want able export selected range of cells .csv file using vba. have come far job excellently cohering selections, fails misearably when multiple columns selected.
here code managed set snippets found on internet: fiddles around ui , since excel speaks high german , need have "." decimal separator instead of "," tweaks that.
sub range_nach_csv_() dim vntfilename variant dim lngfn long dim rngrow excel.range dim rngcell excel.range dim strdelimiter string dim strtext string dim strtextcell string dim strtextcelll string dim bolerstespalte boolean dim rngcolumn excel.range dim wksquelle excel.worksheet dim go on boolean strdelimiter = vbtab go on = true while go on = true vntfilename = application.getsaveasfilename("test.txt", _ filefilter:="txt-file (*.txt),*.txt") if vntfilename = false exit sub end if if len(dir(vntfilename)) > 0 dim ans integer ans = msgbox("datei existiert bereits. Überschreiben?", vbyesno) if ans = vbyes go on = false elseif ans = vbno go on = true else go on = false end if else go on = false end if loop set wksquelle = activesheet lngfn = freefile open vntfilename output lngfn each rngrow in selection.rows strtext = "" bolerstespalte = true each rngcell in rngrow.columns strtextcelll = rngcell.text strtextcell = replace(strtextcelll, ",", ".") if bolerstespalte strtext = strtextcell bolerstespalte = false else strtext = strtext & strdelimiter & strtextcell end if next print #lngfn, strtext next close lngfn end sub
as mentioned sub works coherent selections , multiple selected lines, fails when comes multiple columns.
the current output of sub can seen on here picture: multiple columns failed
as 1 expect, want .csv-file (or respective .txt-file) this: multiple columns desired output
how can accomplish desired behaviour lastly case? , kind include links images? if perceived appropriate, of course.
this might seem little complex, utilize case isn't simple...
it assume each of selected areas same size, , line (as either rows or columns)
sub tester() dim s string, srow string, sep string dim a1 range, rw range, c range, rcount long dim areacount long, x long dim bcolumnsselected boolean dim sel range bcolumnsselected = false set sel = selection areacount = selection.areas.count set a1 = selection.areas(1) if areacount > 1 if a1.cells(1).column <> selection.areas(2).cells(1).column 'areas represent different columns (not different rows) bcolumnsselected = true set sel = a1 end if end if rcount = 0 each rw in sel.rows rcount = rcount + 1 srow = "" sep = "" each c in rw.cells srow = srow & sep & replace(c.text, ",", ".") sep = "," next c 'if there multiple areas selected (as columns), include if bcolumnsselected x = 2 areacount each c in selection.areas(x).rows(rcount).cells srow = srow & sep & replace(c.text, ",", ".") next c next x end if s = s & iif(len(s) > 0, vbcrlf, "") & srow next rw debug.print s end sub
excel excel-vba
No comments:
Post a Comment