• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tarih Formatı

igultekin2000

igultekin2000

Katılım
5 Eylül 2007
Mesajlar
1,247
Excel Vers. ve Dili
ofis 2010
iyi akşamlar; makro sorunsuz çalışıyor, ancak veri aktarıldığında tarih formatı 30.9.2017 gibi şeklinde oluyor ancak ben 30.09.2017 şeklinde olmasını istiyorum. Koda ne gibi ilave yapmam gerekiyor. Teşekkürler.
Kod: 
Sub veri_aktar()
Sheets("HAREKET").Select
A = Range("B2:H" & Cells(Rows.Count, 2).End(3).Row)
ReDim b(1 To UBound(A), 1 To UBound(A, 2))
ReDim b1(1 To UBound(A), 1 To UBound(A, 2))
For i = 1 To UBound(A)
    If A(i, 1) = "Giriş" Then
        say = say + 1
        For y = 1 To UBound(A, 2)
            b(say, y) = A(i, y)
        Next
    End If
    If A(i, 1) = "Çıkış" Then
        say1 = say1 + 1
            For y = 1 To UBound(A, 2)
                b1(say1, y) = A(i, y)
            Next
    End If
Next i

With Sheets("RAPOR")
.Range("A2:J" & Rows.Count).ClearContents
.[A2].Resize(say) = (Application.Index(b, , 3))
.[B2].Resize(say) = (Application.Index(b, , 4))
.[I2].Resize(say) = (Application.Index(b, , 7))

.[C2].Resize(say1) = (Application.Index(b1, , 3))
.[D2].Resize(say1) = (Application.Index(b1, , 5))
.[J2].Resize(say1) = (Application.Index(b1, , 7))
End With

End Sub
 
Tarih olan sütunu seçin,sağ tıklayın ve hücre biçimlendiri seçin.Oradanda Tarih seçin ve tür kısmından 14.03.2001 seçin.Tamama basın.sonra makroyu çalıştırın.:cool:
 
denemiştim.

Orion1' Alıntı:
Tarih olan sütunu seçin,sağ tıklayın ve hücre biçimlendiri seçin.Oradanda Tarih seçin ve tür kısmından 14.03.2001 seçin.Tamama basın.sonra makroyu çalıştırın.:cool:
Genişletmek için tıkla ...
benim de takıldığım nokta orası zaten baştan beri ilgili tarih ve tuta formatı makrodan önce iki tarafta da yani, veri kısmı ve aktarılacak kısım, ikisinde de olmasını istediğim şekilde ancak veri aktarınca 30.9.2017 şekline dönüyor, elle yazınca istediğim formatta, makro veri aktarılınca oluyor. anlayamadım.
 
merhaba ,

Columns("B:B").NumberFormat = "dd/mm/yyyy"

islem yapmasini istediginiz sütunu düzeltip with blogundan sonra kodunuzun son satirina ekleyin .
 
ilginc cunku bu basit bir kod . sorunsuz halletmesi gerekir. bence sorunlu dosyayanın bir ornegini ekleyin
 
kod

hoguz2' Alıntı:
ilginc cunku bu basit bir kod . sorunsuz halletmesi gerekir. bence sorunlu dosyayanın bir ornegini ekleyin
Genişletmek için tıkla ...

Kod: 
Sub veri_aktar()
Sheets("HAREKET").Select
A = Range("B2:H" & Cells(Rows.Count, 2).End(3).Row)
ReDim b(1 To UBound(A), 1 To UBound(A, 2))
ReDim b1(1 To UBound(A), 1 To UBound(A, 2))
For i = 1 To UBound(A)
    If A(i, 1) = "Giriş" Then
        say = say + 1
        For y = 1 To UBound(A, 2)
            b(say, y) = A(i, y)
        Next
    End If
    If A(i, 1) = "Çıkış" Then
        say1 = say1 + 1
            For y = 1 To UBound(A, 2)
                b1(say1, y) = A(i, y)
            Next
    End If
Next i

With Sheets("RAPOR")
.Range("A2:J" & Rows.Count).ClearContents
.[A2].Resize(say) = (Application.Index(b, , 3))
.[B2].Resize(say) = (Application.Index(b, , 4))
.[I2].Resize(say) = (Application.Index(b, , 7))

.[C2].Resize(say1) = (Application.Index(b1, , 3))
.[D2].Resize(say1) = (Application.Index(b1, , 5))
.[J2].Resize(say1) = (Application.Index(b1, , 7))
End With
Sheets("HAREKET").Select
Sheets("HAREKET").Range("A2:J1000").Font.Name = "Calibri" 'yazı fontu
Sheets("HAREKET").Select
Sheets("HAREKET").Range("A2:J1000").Font.Size = 12 'yazı tipi boyutu
Sheets("HAREKET").Select  ' konumlanma
Columns("a:a").NumberFormat = "dd/mm/yyyy"
End Sub
 

Ekli dosyalar

ne yazikki siteden dosya indiremiyorum .

iki sayfaniz var sanirim. hareket ve rapor. dogru sayfada mi islem yaptirdiniz ? iki sayfa icinde calistirin bakalim olacak mi

Sub veri_aktar()
Application.ScreenUpdating = False
Sheets("HAREKET").Select
A = Range("B2:H" & Cells(Rows.Count, 2).End(3).Row)
ReDim b(1 To UBound(A), 1 To UBound(A, 2))
ReDim b1(1 To UBound(A), 1 To UBound(A, 2))
For i = 1 To UBound(A)
If A(i, 1) = "Giriş" Then
say = say + 1
For y = 1 To UBound(A, 2)
b(say, y) = A(i, y)
Next
End If
If A(i, 1) = "Çıkış" Then
say1 = say1 + 1
For y = 1 To UBound(A, 2)
b1(say1, y) = A(i, y)
Next
End If
Next i

With Sheets("RAPOR")
.Range("A2:J" & Rows.Count).ClearContents
.[A2].Resize(say) = (Application.Index(b, , 3))
.[B2].Resize(say) = (Application.Index(b, , 4))
.[I2].Resize(say) = (Application.Index(b, , 7))

.[C2].Resize(say1) = (Application.Index(b1, , 3))
.[D2].Resize(say1) = (Application.Index(b1, , 5))
.[J2].Resize(say1) = (Application.Index(b1, , 7))
End With


Sheets("HAREKET").Select
Sheets("HAREKET").Range("A2:J1000").Font.Name = "Calibri" 'yazı fontu
Sheets("HAREKET").Range("A2:J1000").Font.Size = 12 'yazı tipi boyutu

Columns("A:A").NumberFormat = "dd/mm/yyyy"


Sheets("RAPOR").Select
Columns("A:A").NumberFormat = "dd/mm/yyyy"

Application.ScreenUpdating = True
End Sub
 
Deneyiniz.:cool:
Kod: 
Sub veri_aktar()
Sheets("HAREKET").Select
A = Range("B2:H" & Cells(Rows.Count, 2).End(3).Row)
ReDim b(1 To UBound(A), 1 To UBound(A, 2))
ReDim b1(1 To UBound(A), 1 To UBound(A, 2))
For i = 1 To UBound(A)
    If A(i, 1) = "Giriş" Then
        say = say + 1
        For y = 1 To UBound(A, 2)
           [B][COLOR="Red"] If y = 3 Then
                b(say, y) = CDate(A(i, y))
            Else
                b(say, y) = A(i, y)
            End If[/COLOR][/B]
        Next
    End If
    If A(i, 1) = "Çıkış" Then
        say1 = say1 + 1
            For y = 1 To UBound(A, 2)
                b1(say1, y) = A(i, y)
            Next
    End If
Next i

With Sheets("RAPOR")
.Range("A2:J" & Rows.Count).ClearContents
.[A2].Resize(say) = (Application.Index(b, , 3))
.[B2].Resize(say) = (Application.Index(b, , 4))
.[I2].Resize(say) = (Application.Index(b, , 7))

.[C2].Resize(say1) = (Application.Index(b1, , 3))
.[D2].Resize(say1) = (Application.Index(b1, , 5))
.[J2].Resize(say1) = (Application.Index(b1, , 7))
End With
Sheets("HAREKET").Select
Sheets("HAREKET").Range("A2:J1000").Font.Name = "Calibri" 'yazı fontu
Sheets("HAREKET").Select
Sheets("HAREKET").Range("A2:J1000").Font.Size = 12 'yazı tipi boyutu
Sheets("HAREKET").Select  ' konumlanma
Columns("a:a").NumberFormat = "dd/mm/yyyy"
End Sub
 
denedim olmuyor

Orion1' Alıntı:
Deneyiniz.:cool:
Kod: 
Sub veri_aktar()
Sheets("HAREKET").Select
A = Range("B2:H" & Cells(Rows.Count, 2).End(3).Row)
ReDim b(1 To UBound(A), 1 To UBound(A, 2))
ReDim b1(1 To UBound(A), 1 To UBound(A, 2))
For i = 1 To UBound(A)
    If A(i, 1) = "Giriş" Then
        say = say + 1
        For y = 1 To UBound(A, 2)
           [B][COLOR="Red"] If y = 3 Then
                b(say, y) = CDate(A(i, y))
            Else
                b(say, y) = A(i, y)
            End If[/COLOR][/B]
        Next
    End If
    If A(i, 1) = "Çıkış" Then
        say1 = say1 + 1
            For y = 1 To UBound(A, 2)
                b1(say1, y) = A(i, y)
            Next
    End If
Next i

With Sheets("RAPOR")
.Range("A2:J" & Rows.Count).ClearContents
.[A2].Resize(say) = (Application.Index(b, , 3))
.[B2].Resize(say) = (Application.Index(b, , 4))
.[I2].Resize(say) = (Application.Index(b, , 7))

.[C2].Resize(say1) = (Application.Index(b1, , 3))
.[D2].Resize(say1) = (Application.Index(b1, , 5))
.[J2].Resize(say1) = (Application.Index(b1, , 7))
End With
Sheets("HAREKET").Select
Sheets("HAREKET").Range("A2:J1000").Font.Name = "Calibri" 'yazı fontu
Sheets("HAREKET").Select
Sheets("HAREKET").Range("A2:J1000").Font.Size = 12 'yazı tipi boyutu
Sheets("HAREKET").Select  ' konumlanma
Columns("a:a").NumberFormat = "dd/mm/yyyy"
End Sub
Genişletmek için tıkla ...

bu makroda sorunu çözmedi.
 

Ekli dosyalar

  • hareket sayfası.jpg
    hareket sayfası.jpg
    120.3 KB · Görüntüleme: 4
  • rapor.jpg
    rapor.jpg
    93.5 KB · Görüntüleme: 3
heralde benim excell sorunlu

Orion1' Alıntı:
Ben denedim.Tarihte sorun gözükmüyor.
Ekli dosyayı inceleyiniz.:cool:
Genişletmek için tıkla ...

ekli dosyanızı indirim, makroyu çalıştırdığımda yine benim sistemi döndü, yani 02.01.2018 tarihi , 2.1.2018 şekline döndürdü. oysa ekli dosyanızda normal şekilde yani 02.01.2018 olarak görünüyor.
 
igultekin2000' Alıntı:
ekli dosyanızı indirim, makroyu çalıştırdığımda yine benim sistemi döndü, yani 02.01.2018 tarihi , 2.1.2018 şekline döndürdü. oysa ekli dosyanızda normal şekilde yani 02.01.2018 olarak görünüyor.
Genişletmek için tıkla ...
Bende sorun yok.
Ama Başka bir metodla yapalım veri aktarı.
Ne yapılacak anlatırmısınız?
 
Birde bunu deneyelim.:cool:
Kod: 
If y = 3 Then
     [B][COLOR="Red"] b(say, y) = Format(CDate(A(i, y)), "dd.mm.yyyy")[/COLOR][/B]
Else
      b(say, y) = A(i, y)
 End If
 
bu şekilde oldu

Kod:
Orion1' Alıntı:
Birde bunu deneyelim.:cool:
Kod: 
Sub veri_aktar()
Sheets("HAREKET").Select
A = Range("B2:H" & Cells(Rows.Count, 2).End(3).Row)
ReDim b(1 To UBound(A), 1 To UBound(A, 2))
ReDim b1(1 To UBound(A), 1 To UBound(A, 2))
For i = 1 To UBound(A)
    If A(i, 1) = "Giriş" Then
        say = say + 1
        For y = 1 To UBound(A, 2)
            b(say, y) = A(i, y)
    If y = 3 Then
      b(say, y) = Format(CDate(A(i, y)), "dd.mm.yyyy")
Else
      b(say, y) = A(i, y)
 End If
        Next
    End If
    If A(i, 1) = "Çıkış" Then
        say1 = say1 + 1
            For y = 1 To UBound(A, 2)
                b1(say1, y) = A(i, y)
    If y = 3 Then
      b1(say1, y) = Format(CDate(A(i, y)), "dd.mm.yyyy")
Else
      b1(say1, y) = A(i, y)
 End If
            Next
    End If
Next i

With Sheets("RAPOR")
.Range("A2:J" & Rows.Count).ClearContents
.[A2].Resize(say) = (Application.Index(b, , 3))
.[B2].Resize(say) = (Application.Index(b, , 4))
.[I2].Resize(say) = (Application.Index(b, , 7))

.[C2].Resize(say1) = (Application.Index(b1, , 3))
.[D2].Resize(say1) = (Application.Index(b1, , 5))
.[J2].Resize(say1) = (Application.Index(b1, , 7))
End With
Sheets("HAREKET").Select
Sheets("HAREKET").Range("A2:J1000").Font.Name = "Calibri" 'yazı fontu
Sheets("HAREKET").Select
Sheets("HAREKET").Range("A2:J1000").Font.Size = 12 'yazı tipi boyutu
Sheets("HAREKET").Select  ' konumlanma
Range("A2:A1000").Select
Range("A2:A1000").Value = CDate(Date)
Range("A2:A1000").Value = CDate(Format(Date, "dd.mm.yyyy"))
End Sub

elinize sağlık, bu şekilde oldu, mantığını tam anlayamadım, bu durumun sadeleşmesi mümkün mü, çünkü güzel bir çözüm, başka makroda da kullanabileceğim türden. ama mantığını çözemedim.
Genişletmek için tıkla ...
 
Son düzenleme:
igultekin2000' Alıntı:
Kod:

elinize sağlık, bu şekilde oldu, mantığını tam anlayamadım, bu durumun sadeleşmesi mümkün mü, çünkü güzel bir çözüm, başka makroda da kullanabileceğim türden. ama mantığını çözemedim.
Genişletmek için tıkla ...
Benim yazdığım kod dizinin 3ncü kolonunu tarih şeklinde formatlayıp veriyi o şekilde alıyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst