• DİKKAT

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

karakterleri dönüştürmek

A

aleysan

Katılım
25 Nisan 2009
Mesajlar
51
Excel Vers. ve Dili
2003
herkese merhaba.
ekteki excel dosyasındaki 3 tane sütun var.
1-tarih (17/02/2010 yada 17,02,2010 yada 17.2.2010 yada 17.02.10) gibi tüm tarih tiplerini tek tipe (gg.aa.yyyy) döndürmesini,
2-miktar (12500 yada 12,500 yada 12.500 yada 12,5) gibi tüm miktar yazılışlarını tek tipe(12.500) çevirmesini,
3-plaka (48 AH 250 yada 48AH250 yada 48.AH.250 yada 34 ATF 4552) gibi plaka şekillerini tek tipe (RR HH/HHH RRR/RRRR) şekline dönüştürmemi sağlayaca bir butonu nasıl yapabilirim bunun kodu nedir.
herkese iyi çalışmalar.
 

Ekli dosyalar

Selamlar,

12.2 değerinin yeni karşılığı ne olmalı?
 
Selamlar,

Aşağıdaki kodu denermisiniz. Orjinal verilerinizi bozmamak için düzeltilmiş yeni liste D-E-F sütunlarına yapılmaktadır.

Kod: 
Option Explicit
 
Sub KARAKTERLERİ_DÖNÜŞTÜR()
    Dim X1 As Long, X2 As Integer, X3 As Integer, X4 As Integer, WF As WorksheetFunction
    Dim Plaka As String, Veri_1 As String, Veri_2 As String, Veri_3 As String
 
    Set WF = WorksheetFunction
 
    Range("D:F").ClearContents
    Range("D:F").NumberFormat = "General"
 
    For X1 = 2 To Range("A65536").End(3).Row
        If Cells(X1, 1) <> "" Then
            Cells(X1, "D") = DateSerial(Mid(Cells(X1, 1), 7, 4), Mid(Cells(X1, 1), 4, 2), Mid(Cells(X1, 1), 1, 2))
        End If
 
        If Cells(X1, 2) <> "" Then
            Cells(X1, "E") = Replace(Replace(Cells(X1, 2), ".", ""), ",", "")
            If Len(Cells(X1, "E")) < 5 Then Cells(X1, "E") = Cells(X1, "E") & WF.Rept(0, 5 - Len(Cells(X1, "E")))
        End If
 
        If Cells(X1, 3) <> "" Then
            Plaka = Evaluate("=UPPER(""" & Cells(X1, 3) & """)")
            Plaka = Replace(Plaka, " ", "")
            Plaka = Replace(Plaka, ",", "")
            Plaka = Replace(Plaka, ".", "")
            Plaka = Replace(Plaka, "/", "")
            Plaka = Replace(Plaka, "*", "")
            Plaka = Replace(Plaka, "-", "")
            Plaka = Replace(Plaka, "+", "")
 
            For X2 = 1 To Len(Plaka)
                If IsNumeric(Mid(Plaka, X2, 1)) Then
                    Veri_1 = Veri_1 & Mid(Plaka, X2, 1)
                Else
                    Exit For
                End If
            Next
 
            For X3 = 1 To Len(Plaka)
                If Not IsNumeric(Mid(Plaka, X3, 1)) Then
                    Veri_2 = Veri_2 & Mid(Plaka, X3, 1)
                End If
            Next
 
            For X4 = Len(Plaka) To 1 Step -1
                If IsNumeric(Mid(Plaka, X4, 1)) Then
                    Veri_3 = Veri_3 & Mid(Plaka, X4, 1)
                Else
                    Exit For
                End If
            Next
            Cells(X1, "F") = Veri_1 & " " & Veri_2 & " " & StrReverse(Veri_3)
            Veri_1 = ""
            Veri_2 = ""
            Veri_3 = ""
        End If
    Next
 
    Set WF = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

Ekli dosyalar

selam korhan ayhan şuan kullandığım pc deoffice yok ilk fırsatta deneyip sonucu bildircem şimdilik sağolun varolun
 
merhabalar arkadaşlar ben bu kod işinden hiç anlamam birisi korhan ayhan arkadaşın verdiği kodu ilk mesajıma ekli excel sayfasındaki botuna tıklayınca olayına yapabilirmi ben denedim ama beceremedim. kolay gelsin.
 
merhaba sayın korhan ayhan, işlemi verdiğiniz linkdeki şekilde yaptım fakat butonu tıklayınca "visual basic makrosu,bir sözdizimi hatası nedeniyle çalıştırılamıyor" şeklinde uyarı veriyor.
 
Selamlar,

#4 nolu mesajımdan uygulanmış örnek dosyayı indirebilirsiniz.
 
merhaba sayın korhan ayhan.
herşeyden önce teşekkür ederim. bir iki ilave daha isteyecektim bu konuyla ilgili
1-tarih çok güzel olmuş. birde yılı 2 haneli(01,01,10) yazılsa bile 4 haneliye (01.01.2010) çevirtebilirmiyiz
2-miktar kısmında ben göremedim hep aynı kalıyor yani yazdığımızın aynısını ceviriyor.
3- plakada çok güzel onada rakamlarla harfler arasına nokta yada virgül konsa (45.,ahr.,456)bile onları silsin(45 AHR 456) birde harfler küçük yazılsa bile büyük harflerle yazdırabilirmiyiz.
tekrar teşekkür ederim.
 
Selamlar,

Üstteki mesajımdaki kodu ve dosyayı güncelledim. Dosyadaki veriler için makroyu çalıştırdım. Bir sorun görünmüyor. Sizdeki veriler istediğiniz gibi düzelmiyorsa düzelmeyen verileri içeren bir örnek dosya ekleyin. Dosyanızın üzerinde çözüm arayalım.
 
selam sayın korhan ayhan
hocam bu sefer tamam herangi bir noksanlık göremedim
tek kelimeyle süper olmuş
bu proğramı bir arkadaş kullancak
kendisi kullansın ihtiyaç halinde sizi tekrar yardımlarınıza başvururuz
şimdilik hoşçakalın elleriniz dert görmesin.
 
selam sayın korhan ayhan
oluşan bir iki hatayı gösteren dosya ekte talepler ve hatalar kırmızı ile gösterilidi.
kolay gelsin
 

Ekli dosyalar

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Option Explicit
 
Sub KARAKTERLERİ_DÖNÜŞTÜR()
    Dim X1 As Long, X2 As Integer, X3 As Integer, X4 As Integer, WF As WorksheetFunction
    Dim Gün As Byte, Ay As Byte, Yıl As Integer
    Dim Plaka As String, Veri_1 As String, Veri_2 As String, Veri_3 As String
    
    Set WF = WorksheetFunction
    
    Range("D:F").ClearContents
    Range("D:F").NumberFormat = "General"
    
    For X1 = 2 To Range("A65536").End(3).Row
        If Cells(X1, 1) <> "" Then
            If InStr(1, Cells(X1, 1), ".") > 0 Then
                Gün = Split(Cells(X1, 1), ".")(0)
                Ay = Split(Cells(X1, 1), ".")(1)
                Yıl = Split(Cells(X1, 1), ".")(2)
                Cells(X1, "D") = DateSerial(Yıl, Ay, Gün)
            ElseIf InStr(1, Cells(X1, 1), ",") > 0 Then
                Gün = Split(Cells(X1, 1), ",")(0)
                Ay = Split(Cells(X1, 1), ",")(1)
                Yıl = Split(Cells(X1, 1), ",")(2)
                Cells(X1, "D") = DateSerial(Yıl, Ay, Gün)
            Else
                Cells(X1, "D") = DateSerial(Mid(Cells(X1, 1), 7, 4), Mid(Cells(X1, 1), 4, 2), Mid(Cells(X1, 1), 1, 2))
            End If
        End If
        
        If Cells(X1, 2) <> "" Then
            Plaka = Evaluate("=UPPER(""" & Cells(X1, 2) & """)")
            Plaka = Replace(Plaka, " ", "")
            Plaka = Replace(Plaka, ",", "")
            Plaka = Replace(Plaka, ".", "")
            Plaka = Replace(Plaka, "/", "")
            Plaka = Replace(Plaka, "*", "")
            Plaka = Replace(Plaka, "-", "")
            Plaka = Replace(Plaka, "+", "")
            
            For X2 = 1 To Len(Plaka)
                If IsNumeric(Mid(Plaka, X2, 1)) Then
                    Veri_1 = Veri_1 & Mid(Plaka, X2, 1)
                Else
                    Exit For
                End If
            Next
            
            For X3 = 1 To Len(Plaka)
                If Not IsNumeric(Mid(Plaka, X3, 1)) Then
                    Veri_2 = Veri_2 & Mid(Plaka, X3, 1)
                End If
            Next
            
            For X4 = Len(Plaka) To 1 Step -1
                If IsNumeric(Mid(Plaka, X4, 1)) Then
                    Veri_3 = Veri_3 & Mid(Plaka, X4, 1)
                Else
                    Exit For
                End If
            Next
            Cells(X1, "E") = Veri_1 & " " & Veri_2 & " " & StrReverse(Veri_3)
            Veri_1 = ""
            Veri_2 = ""
            Veri_3 = ""
        End If
        
        If Cells(X1, 3) <> "" Then
            Cells(X1, "F") = Replace(Replace(Cells(X1, 3), ".", ""), ",", "")
            If Len(Cells(X1, "F")) < 5 Then Cells(X1, "F") = Cells(X1, "F") & WF.Rept(0, 5 - Len(Cells(X1, "F")))
        End If
    Next
    
    Set WF = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
selam sayın korhan ayhan
son verdiğin kod sorunların bazılarını çözmekle beraber bazı sorunlarda ortaya çıkardı.
siz bana sutun sıralamasını (13 mesajdaki örnekde yani sütunların sırası tarih,plaka,mıktar şeklinde olabilirmi )değiştirebilirseniz biz onu kullanlım.
 
Selamlar,

Son önerdiğim kodda sıralama zaten istediğiniz şekildedir. Siz sütunların yerini değiştirip kodu öyle çalıştırın.

Kodun tüm sorunlarınıza yanıt verebilmesi için problem yaratan tüm verilerinizi görmem gerekir. Böyle verileri içeren bir örnek dosya eklerseniz çözüm üretebiliriz.
 
merhaba
sütunları ben eski düzende algıladığımdan hata veriyor dedim şuan tek dönüştürülmeyen biçim var
tarih kısmında oda(1.1.10) yani 0 kullanmadan aralara nokta koyarak yılı 2 haneli yazıldığında hata veriyor çevirmiyor. diğerlerinde sorun yok.
kolay gelsin.
 
unutmadan ben bu örneği sayfayı kopyalayıp aynı projenin ikinci sayfasınada uygulayacağım 3 sayfada ise bu iki sayfaya farkklı yerlerden alıp yapıştırdığım verilerin karşılaştırılması sonucunu dökcem kısaca kopyalayınca yapıştırdığım yerde problem olurmu
 
Selamlar,

#14 nolu mesajımdaki kodu güncelledim. İncelermisiniz.
 
merhabalar sayın korhan ayhan hocam çok güzel olmuş herşey için çok teşekkür ederim.
ellerinize sağlık.umarım sizde her sıkıştığınızda bir yardımcı olanınız olur.
yöneticilerden rica ediyorum konuyu kapatmasınlar çünkü kullandıkça taleplerimizin olma ihtimali yüksek. herkese kolay gelsin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst