CSV başında sıfır olan rakamlar

M

m__uzun

Katılım
20 Haziran 2015
Mesajlar
36
Excel Vers. ve Dili
office 2010 türkçe
Altın Üyelik Bitiş Tarihi
21/08/2022
Selam arkadaşlar

csv raporunu makro ile düzenleyip, düzenlenmiş verileri yeni bir dosya olarak hem csv hem de xlsx dosyası olarak kaydediyorum.
fakat yeni kaydedilen dosyada başında sıfır olan rakamların sıfırlarını almıyor. '0123 gibi denedim csv dosyasına aktarımda yine başında sıfır olmadan aktarıyor.
yardımcı olurmusunuz teşekkürler

kodun bazı gerekli kısımlarını


Kod: 
.
.
.

Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:=";", TrailingMinusNumbers:=True
                
''   ,
  
coltitle = ...
coltitle = coltitle & "TAX_..."

coltonotdelete = Split(coltitle, ",")

Dim cols As Range
For i = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column To 1 Step -1
   If IsError(Application.Match(ws.Cells(1, i).Value, coltonotdelete, 0)) Then
        ws.Columns(i).Delete
    End If
Next i

lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

-------data = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastcol)).Value-------

-------ReDim Preserve data(1 To UBound(data, 1), 1 To lastcol + 8)-------

data(1, UBound(data, 2) - 7) = "..."
data(1, UBound(data, 2) - 6) = "aktar"
.
.
.

    
Say = 1

For i = LBound(data) + 1 To UBound(data)
.
.

                     For k = 1 To Len(data(i, ID))
                                           karakter = Mid(data(i, ID), k, 1)
                                           If IsNumeric(karakter) Then
                                               rakam = rakam & karakter
                                           Else
                                               harf = harf & karakter
                                           End If
                      Next k
                            

Next i



-------ReDim newData(1 To Say, LBound(data, 2) To UBound(data, 2))-------

yenidata = 2
.
.

            For i = LBound(data, 1) To UBound(data, 1)
                
                    If i = 1 Then
                        For j = LBound(data, 2) To UBound(data, 2)
                            newData(1, j) = data(1, j)
                        Next j
                    End If
            

                If data(i, aktar) = 1 Then
                
                    For j = LBound(data, 2) To UBound(data, 2)
                            newData(yenidata, j) = data(i, j)
                    Next j
                    yenidata = yenidata + 1
                End If
            
            Next i
.
.
        

        Sheets.Add(after:=Sheets(Sheets.Count)).Name = Format(Now, "hh.mm.ss"): isimm = Format(Now, "hh.mm.ss")
        Set ws1 = Sheets(isimm)
        ws1.Select


-------ws1.Range("A1").Resize(UBound(newData, 1), UBound(newData, 2)).Value = newData-----
    

coltodelete = Split(coltitled, ",")

For i = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column To 1 Step -1
    If Not IsError(Application.Match(ws1.Cells(1, i).Value, coltodelete, 0)) Then
        ws1.Columns(i).Delete
    End If
Next i

-------araarray = ActiveSheet.UsedRange.Value-----

Filename = "C:\ " & isim & " " & Format(Now, "DD.MM.YYYY hh.mm.ss") & ".xlsx"
ActiveWorkbook.SaveAs Filename, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close False
    
Set TargetWorkbook = CreateObject("Excel.Application")
TargetWorkbook.Workbooks.Add

Set TargetWorksheet = TargetWorkbook.Workbooks(1).Sheets(1)
------TargetWorksheet.Range("A1").Resize(UBound(araarray, 1), UBound(araarray, 2)).Value = araarray------
        
CSVFileName = "C:\ " & isim & " " & Format(Now, "DD.MM.YYYY hh.mm.ss") & ".csv"
TargetWorkbook.Workbooks(1).SaveAs CSVFileName, xlCSV
    
TargetWorkbook.Quit
 
M

m__uzun

Katılım
20 Haziran 2015
Mesajlar
36
Excel Vers. ve Dili
office 2010 türkçe
Altın Üyelik Bitiş Tarihi
21/08/2022
yok mu yine bi cevap verecek
 
M

MusaPEKEL

Altın Üye
Katılım
29 Ağustos 2016
Mesajlar
65
Excel Vers. ve Dili
2013
Altın Üyelik Bitiş Tarihi
16-01-2027
m__uzun' Alıntı:
Selam arkadaşlar

csv raporunu makro ile düzenleyip, düzenlenmiş verileri yeni bir dosya olarak hem csv hem de xlsx dosyası olarak kaydediyorum.
fakat yeni kaydedilen dosyada başında sıfır olan rakamların sıfırlarını almıyor. '0123 gibi denedim csv dosyasına aktarımda yine başında sıfır olmadan aktarıyor.
yardımcı olurmusunuz teşekkürler

kodun bazı gerekli kısımlarını


Kod: 
.
.
.

Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:=";", TrailingMinusNumbers:=True
               
''   ,
 
coltitle = ...
coltitle = coltitle & "TAX_..."

coltonotdelete = Split(coltitle, ",")

Dim cols As Range
For i = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column To 1 Step -1
   If IsError(Application.Match(ws.Cells(1, i).Value, coltonotdelete, 0)) Then
        ws.Columns(i).Delete
    End If
Next i

lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

-------data = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastcol)).Value-------

-------ReDim Preserve data(1 To UBound(data, 1), 1 To lastcol + 8)-------

data(1, UBound(data, 2) - 7) = "..."
data(1, UBound(data, 2) - 6) = "aktar"
.
.
.

   
Say = 1

For i = LBound(data) + 1 To UBound(data)
.
.

                     For k = 1 To Len(data(i, ID))
                                           karakter = Mid(data(i, ID), k, 1)
                                           If IsNumeric(karakter) Then
                                               rakam = rakam & karakter
                                           Else
                                               harf = harf & karakter
                                           End If
                      Next k
                           

Next i



-------ReDim newData(1 To Say, LBound(data, 2) To UBound(data, 2))-------

yenidata = 2
.
.

            For i = LBound(data, 1) To UBound(data, 1)
               
                    If i = 1 Then
                        For j = LBound(data, 2) To UBound(data, 2)
                            newData(1, j) = data(1, j)
                        Next j
                    End If
           

                If data(i, aktar) = 1 Then
               
                    For j = LBound(data, 2) To UBound(data, 2)
                            newData(yenidata, j) = data(i, j)
                    Next j
                    yenidata = yenidata + 1
                End If
           
            Next i
.
.
       

        Sheets.Add(after:=Sheets(Sheets.Count)).Name = Format(Now, "hh.mm.ss"): isimm = Format(Now, "hh.mm.ss")
        Set ws1 = Sheets(isimm)
        ws1.Select


-------ws1.Range("A1").Resize(UBound(newData, 1), UBound(newData, 2)).Value = newData-----
   

coltodelete = Split(coltitled, ",")

For i = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column To 1 Step -1
    If Not IsError(Application.Match(ws1.Cells(1, i).Value, coltodelete, 0)) Then
        ws1.Columns(i).Delete
    End If
Next i

-------araarray = ActiveSheet.UsedRange.Value-----

Filename = "C:\ " & isim & " " & Format(Now, "DD.MM.YYYY hh.mm.ss") & ".xlsx"
ActiveWorkbook.SaveAs Filename, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close False
   
Set TargetWorkbook = CreateObject("Excel.Application")
TargetWorkbook.Workbooks.Add

Set TargetWorksheet = TargetWorkbook.Workbooks(1).Sheets(1)
------TargetWorksheet.Range("A1").Resize(UBound(araarray, 1), UBound(araarray, 2)).Value = araarray------
       
CSVFileName = "C:\ " & isim & " " & Format(Now, "DD.MM.YYYY hh.mm.ss") & ".csv"
TargetWorkbook.Workbooks(1).SaveAs CSVFileName, xlCSV
   
TargetWorkbook.Quit
Genişletmek için tıkla ...
Kod: 
Sub DuzenleVeKaydet()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim data As Variant
    Dim i As Long, j As Long, k As Long
    Dim newData() As Variant
    Dim rakam As String, karakter As String, harf As String
    Dim yenidata As Long
    Dim isim As String
    Dim coltitle As String, coltonotdelete As Variant
    Dim aktar As Long

    ' Çalışma sayfasını belirt
    Set ws = ThisWorkbook.Sheets("VeriSayfasi")

    ' Veri sütunları arasındaki virgülle ayrılmış başlıkları belirt
    coltitle = "TAX_..."
    coltonotdelete = Split(coltitle, ",")

    ' Metin sütunlarına ayır
    ws.Columns("A:A").NumberFormat = "@"
    ws.Range("A1").CurrentRegion.TextToColumns Destination:=ws.Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:=";", TrailingMinusNumbers:=True

    ' Belirli başlıkları sil
    For i = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column To 1 Step -1
        If IsError(Application.Match(ws.Cells(1, i).Value, coltonotdelete, 0)) Then
            ws.Columns(i).Delete
        End If
    Next i

    ' Veriyi al
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    data = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value

    ' Yeni veri için boyut ayarla
    ReDim Preserve data(1 To UBound(data, 1), 1 To lastCol + 8)

    ' Diğer işlemleri yap...

    ' Başında sıfır olan rakamları korumak için metin formatında düzenleme yap
    For i = LBound(data) To UBound(data)
        For j = LBound(data, 2) To UBound(data, 2)
            If IsNumeric(data(i, j)) Then
                data(i, j) = "'" & data(i, j)
            End If
        Next j
    Next i


    ' Yeni veriyi kaydet
    isim = "DosyaAdi"
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Format(Now, "hh.mm.ss")
    Set ws1 = Sheets(Format(Now, "hh.mm.ss"))

    

    ' Excel dosyasını kaydet
    ws1.Copy
    ActiveWorkbook.SaveAs "C:\" & isim & " " & Format(Now, "DD.MM.YYYY hh.mm.ss") & ".xlsx"
    ActiveWorkbook.Close False

    ' CSV dosyasını kaydet
    ActiveWorkbook.SaveAs "C:\" & isim & " " & Format(Now, "DD.MM.YYYY hh.mm.ss") & ".csv", xlCSV
    ActiveWorkbook.Close False
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst