MS Excel

Zdravím, mám následující kód, který exportuje sloupec B do csv, problém je ten, že se mi exportuje i část sloupce A a to ta část, kde končí hodnoty v sloupci B a pokračují už jen hodnoty v sloupci A.

Prosím o pomoc. Díky.Marek

Sub export_first()
Application.DisplayAlerts = False
Dim wb As Workbook, InitFileName As String, fileSaveName As String

InitFileName = "c:\1\" & Format(Now, "yyyymmddhhmm")

Sheets("Tomas").Range("B1:B20").SpecialCells(xlCellTypeVisible).Copy

Set wb = ActiveWorkbook

fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _
fileFilter:="Semicolon separated CSV (*.csv), *.csv")

With wb
If fileSaveName <> "False" Then

.SaveAs fileSaveName, FileFormat:=xlCSV, Local:=True
.Close
Else
.Close False
Exit Sub
End If
End With

End Sub

Zaslat odpověď >

elninoslov(15.2.2019 15:10)#042757

Ak to chcete robiť cez Copy, tak to musíte aj niekam prilepiť. A to nerobíte. Pozrite sa napr. sem. Vám tam absentuje vytvorenie cieľového súboru.

EIDT: Alebo to urobte úplne inak, napr. takto, rýchlo, bez kopírovania, bez vytvárania nového okna Excelu:
Sub export_first()
Dim rngArea As Range, i As Long, iRow As Long, sVal As String, arrVal(), fileSaveName As String
With Sheets("Tomas").Range("B1:B20")
arrVal = .Value

For Each rngArea In .SpecialCells(xlCellTypeVisible).Areas
With rngArea
iRow = .Row

For i = iRow To iRow + .Rows.Count - 1
sVal = sVal & IIf(LenB(sVal) = 0, vbNullString, vbCrLf) & arrVal(i, 1)
Next i
End With
Next rngArea

End With
fileSaveName = Application.GetSaveAsFilename(InitialFileName:="c:\1\" & Format(Now, "yyyymmddhhnn"), _
fileFilter:="Semicolon separated CSV (*.csv), *.csv")

If fileSaveName <> "False" Then
i = FreeFile
Open fileSaveName For Output As #i
Print #i, sVal
Close #i
End If
End Sub
Ešte bude záležať na tom, aký typ údajov tam máte.

Příloha: zip

42757_export-oblasti-do-csv.zip (19kB, staženo 26x)

citovat

Marekkoc(15.2.2019 20:12)#042758

Děkuju, je to OK. Popíšu co má vše dělat můj xlsm a zasílám jej zároveň v příloze. Takže, když otevřeš můj soubor jsou tam 4 tlačítka -
Natáhni- má za úkol natáhnout názvy souborů z adresáře c:\3.
Ořezat- má za úkol natáhlé soubory ořezat dle daných pravidel.
Smazat duplicity- smaže všechny duplicity z ořezaných souborů.
Export - udělá export do csv ořezaných názvů souborů bez duplicit do adresáře c:\1.

No nejsem v tom úplně v kramflecích, ještě to budu muset zautomatizovat např. při natahování nastavit výchozí buňku jako A1, možná vše dat pod jedno tlačítko a mrknout zda to nemůže tvořit chyby.

Příloha: rar

42758_tomas.rar (23kB, staženo 24x)

citovat

MePExG(15.2.2019 20:27)#042759

Aj PQ by dokázalo Natiahnuť, Orezať a Zmazať a na Export buď použiť ručné uloženie, alebo už dodaný program. Ak by ste však chceli, aby som Vám PQ urobil potrebujem popis všetkých činností, najlepšie s príkladmi vstupu a výstupu a k tomu aspoň jeden typ z každého vstupného súboru.citovat

elninoslov(15.2.2019 21:31)#042760

Polovica kódu, je tam len preto aby Vám ukázalo vizuál v bunkách, no makro ich nepotrebuje.
Sub ListFiles()
Dim i As Long, sFile As String, sLeftFile As String, sPath As String, fileSaveName As String, sVal As String, colFiles As New Collection
Dim arrFiles() As String, iFiles As Long, iCol

With ThisWorkbook.Worksheets("Tomas")
sPath = .Cells(1, 4).Value
If Len(sPath) = 0 Or Len(Dir(sPath)) = 0 Then MsgBox "Chýba zdroj", vbCritical: Exit Sub

sFile = Dir(sPath & "*.*", vbNormal)
On Error Resume Next
While sFile <> ""
sLeftFile = Split(sFile, "_")(0)
colFiles.Add Array(sFile, sLeftFile), sLeftFile

If Err.Number = 0 Then
sVal = sVal & IIf(LenB(sVal) = 0, vbNullString, vbCrLf) & sLeftFile
Else
Err.Clear
End If
sFile = Dir()
Wend
On Error GoTo 0
With .Columns(1).Resize(2)
.ClearContents

ReDim arrFiles(1 To colFiles.Count, 1 To 2)
i = 0
For Each iCol In colFiles
i = i + 1
arrFiles(i, 1) = iCol(0)
arrFiles(i, 2) = iCol(1)
Next iCol
.Resize(i, 2).Value = arrFiles
End With
End With

fileSaveName = Application.GetSaveAsFilename(InitialFileName:="c:\1\" & Format(Now, "yyyymmddhhnn"), _
fileFilter:="Semicolon separated CSV (*.csv), *.csv")

If fileSaveName <> "False" Then
i = FreeFile
Open fileSaveName For Output As #i
Print #i, sVal
Close #i
End If
End Sub

Příloha: zip

42760_export-oblasti-do-csv.zip (22kB, staženo 28x)

citovat

Marekkoc(16.2.2019 19:34)#042761

Díky moc elninoslov. Máš to daleko efektivnější. Měj se. Marekcitovat

Téma: Export sloupce do csv

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje