[es] - [Excel] Makro - brisanje reda i snimanje kao csv file

mirjanagb
mirjana kovacevic
austrija

Član broj: 160826
Poruke: 184
*.bankgutmann.co.at.

+1 Profil

[Excel] Makro - brisanje reda i snimanje kao csv file

^{19.02.2008. u 10:51 - pre 201 meseci}

da li moze da se napise makro za ovo:

treba da selektujem brojeve npr od A1:A168
i da snimim kao csv file ali samo tih 168 brojeva, i kad otvorim na primer u notepade da je snimljeno samo tih 168 br.
znaci bez zadnjeg praznog reda.

sve ja to lepo snimim, ali uvek kad otvorim notepade ostane taj poslednji 169 red prazan.

hvala unapred na pomoci

Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2276
212.200.27.*

Sajt: www.gowi.rs

+111 Profil

Re: [Excel] Makro - brisanje reda i snimanje kao csv file

^{19.02.2008. u 11:07 - pre 201 meseci}

Pogledaj ovo: http://www.ozgrid.com/forum/showthread.php?t=61984

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Odgovor na temu

mirjanagb
mirjana kovacevic
austrija

Član broj: 160826
Poruke: 184
*.bankgutmann.co.at.

+1 Profil

Re: [Excel] Makro - brisanje reda i snimanje kao csv file

^{19.02.2008. u 13:00 - pre 201 meseci}

Sub SaveSelectionAsCSV()
Dim rRange As Range
Dim ws As Worksheet
Dim stTextName As String

On Error Resume Next
Application.DisplayAlerts = False
Set rRange = Application.InputBox(Prompt:= _
"Please select a range with your Mouse to be saved as xlCSV.", _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True

If rRange Is Nothing Then
Exit Sub
Else
stTextName = Replace(ThisWorkbook.Name, ".xls", "")
Set ws = Worksheets.Add()
rRange.Copy ws.Cells(1, 1)
ws.Move
Application.DisplayAlerts = False
Range("A1:A168").Select
Application.CutCopyMode = False
Selection.NumberFormat = "#,##0.000000000000"
Columns("A:A").ColumnWidth = 20
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs _
Filename:="P:........... .csv", _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End If

End Sub

ovaj kod dobro radi samo je problem:
ono sto ja kopiram jeste formula i kad ga snimi kao csv u drugi worksheets snimi ga kao formulu ..
tako kad otvorim npr. notepade snimljeno je #Ref!

gde da napisem i KAKO kod za Paste Special tako da ga na kraju snimi kao broj???

Odgovor na temu

mirjanagb
mirjana kovacevic
austrija

Član broj: 160826
Poruke: 184
*.bankgutmann.co.at.

+1 Profil

Re: [Excel] Makro - brisanje reda i snimanje kao csv file

^{19.02.2008. u 15:08 - pre 201 meseci}

ok,
napisala sam, ali problem je sto nece da izbrise taj zadnji red ...

uvek ostaje ..

Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2276
212.200.27.*

Sajt: www.gowi.rs

+111 Profil

Re: [Excel] Makro - brisanje reda i snimanje kao csv file

^{19.02.2008. u 15:11 - pre 201 meseci}

Code:

Sub SaveSelectionAsCSV()
    Dim rRange As Range
    Dim ws As Worksheet
    Dim stTextName As String


    On Error Resume Next
    Application.DisplayAlerts = False
    Set rRange = Application.InputBox(Prompt:= _
    "Please select a range with your Mouse to be  saved as xlCSV.", _
    Title:="SPECIFY RANGE", Type:=8)
    On Error GoTo 0
    Application.DisplayAlerts = True

    If rRange Is Nothing Then
        Exit Sub
    Else
        stTextName = Replace(ThisWorkbook.Name, ".xls", "")
        Set ws = Worksheets.Add()
        rRange.Copy                                ' Ovo se modifikuje
        ws.Cells(1, 1).PasteSpecial xlPasteValues  ' PasteSpecial
        ws.Move
        Application.CutCopyMode = False
        Application.DisplayAlerts = False
     ' Ovde  dinamički određuje opseg  na kom treba da primeni format
        Range("A1").Resize(rRange.Rows.Count).NumberFormat = "#,##0.000000000000"
        ActiveWorkbook.SaveAs _
        Filename:="C:\TEMP\Test.csv", _
        FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
    End If

End Sub

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Odgovor na temu

mirjanagb
mirjana kovacevic
austrija

Član broj: 160826
Poruke: 184
*.bankgutmann.co.at.

+1 Profil

Re: [Excel] Makro - brisanje reda i snimanje kao csv file

^{19.02.2008. u 15:35 - pre 201 meseci}

ok.
i otvorim ovaj csv file u notepade-u i ono mi opet snimi prvih 168 redova i onda ova treperuca crtica se nalazi na pocetku 169 reda. a taj red ne sme da bude ...

da li moze nesto da se napise da ona ostane na pocetku 168 reda ...

nasla sam nesto ovako

Sub textfile()
Dim fs As Object, a As Object, i As Integer, s As String, t As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\file.txt", True)
s = "" 'clear buffer
c = 1 ' start in column "A"
r = ActiveCell.Row ' set the active row to write

While Not IsEmpty( Cells(r, c)) 'start at column 1 and do until no more columns of data
s = s & Cells(r, c) & " " 'write a cell of data and add a space
c = c + 1 'incement to next column
Wend
a.writeline s 'write line to text file
a.writeline vbCr 'Carridge Return

End Sub

ali ne znam kako da upotrebim u mom kodu....

evo to bi bio taj fajl.

Prikačeni fajlovi

verteilung.csv - 2.68k

Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2276
212.200.27.*

Sajt: www.gowi.rs

+111 Profil

Re: [Excel] Makro - brisanje reda i snimanje kao csv file

^{20.02.2008. u 09:57 - pre 201 meseci}

Excel kad snimi kao tekst file ubacuje poslednji red prazan. Ako ti to baš smeta, umesto da koristiš Save As treba da otvoriš tekst file i direktno prepišeš podatke iz tabele u tekst file - slično kodu koji si našla. Prepravljena verzija koja pravi csv izgledala bi npr:

Code:

Sub TextStreamTest()
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'ASCII ili Unicode
    Dim fs, f, ts
    Dim strFileName As String
    Dim rRange As Range
    Dim rw As Long, cl As Integer
    Dim strRed As String

    Application.DisplayAlerts = False
    Set rRange = Application.InputBox(Prompt:= _
    "Zadaj opseg koji treba sacuvati kao text file ", _
    Title:="SPECIFY RANGE", Type:=8)
    On Error GoTo 0
    Application.DisplayAlerts = True
    If rRange Is Nothing Then
        Exit Sub
    Else
       Set fs = CreateObject("Scripting.FileSystemObject")
       strFileName = "C:\TEMP\test1.txt"
       fs.CreateTextFile strFileName      'Create a file
       Set f = fs.GetFile(strFileName)
       Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
       ' Petlja za upis u Text file
       For rw = 1 To rRange.Rows.Count
         strRed = rRange.Cells(rw, 1).Text  ' Prva celija iz reda se obavezno upisuje
         For cl = 2 To rRange.Columns.Count ' Ostale celije iz reda
             strRed = strRed & "," & rRange.Cells(rw, cl).Text 'dodavanje zareza za razdvajanje i vrednosti iz celije
         Next cl
         If rw < rRange.Rows.Count Then
            ts.Writeline strRed
         Else
            ts.Write strRed
         End If
      Next rw
      ts.Close
    End If
End Sub

Da napomenem ono što je tebi bitno Writeline upisuje kraj reda a write upisuje string bez kraja reda u textstream

_{[Ovu poruku je menjao Jpeca dana 20.02.2008. u 11:09 GMT+1]}

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Odgovor na temu