• DİKKAT

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

Hücrelerde nokta ve rakamları ayırt edilmesi

Diğer hücreler aynen kalınması istiyorum birçok firmalarin verileri olduğu için makro ile çözümlenmesinde istiyorum
 
dosyaniza bakmadim ama bu kod hucre icindeki rakam ve diger karakterleri siliyor ortasinda sonunda silinmesini istemediginiz karakterleer varsa bilemiyorummm


Sub Remove()

Dim Rng As Range
Dim Alan1 As Range
Set Alan1 = Range("A1:A50")
On Error Resume Next
For Each Rng In Alan1
xOut = ""
For i = 1 To Len(Rng.Value)
xTemp = Mid(Rng.Value, i, 1)
If xTemp Like "[a-z]" Or xTemp Like "[A-Z]" Then
xStr = xTemp
Else
xStr = ""
End If
xOut = xOut & xStr
Next i
Rng.Value = xOut
Next
End Sub
 
1903emre34@gmail.com' Alıntı:
Merhaba,

Hesap planındaki nokta ve rakam başlayan açıklamaları, nokta ve rakamları çıkartılması istiyorum (Sarı ile boyalı hücreler) nasıl kod oluşturabiliriz

http://s8.dosya.tc/server4/nhmo70/Kitap.zip.html
Genişletmek için tıkla ...

Alternatif;

Cells(i, 3).Value = veri buradaki kolon bilgisini kendinize göre düzenleyiniz.

Kod: 
Sub Veri_Duzenle()
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    For i = 1 To sonsatir
        veri = veritemizle(Cells(i, 1).Value)
        Cells(i, 3).Value = veri
    Next i
End Sub

Function veritemizle(veristr)
    veristrorg = veristr
    veristr = Trim(Replace(veristr, ".", ""))
    If IsNumeric(Left(veristr, 1)) Then
       veristr = Trim(veristrorg)
       veristr = Trim(Mid(veristr, 2, Len(veristr)))
       veristr = Trim(Mid(veristr, InStr(veristr, ".") + 1, Len(veristr)))
       veritemizle = veristr
    Else
      veritemizle = veristrorg
    End If
End Function
 
asri hocam merhaba ,

bu konuya bakarken internette bir kod gordum cok hosuma gitti . cunku silmek istediginiz karakterleri karakter koduna gore secme sansiniz var. kod asagidaki gibi
fakat bende calismadi calistirinca bir etki alamadim. acaba sayfa ismi ola sheet1 kısmını mı degistirmeliyim dedim. sayfa1 seklinde denedim bir de activewoorksheet olarak denedim. busefer de function modulunde strResult = strResult & Mid(strSource, i, 1)
satirinda hata veriyor. bir bakabilir misiniz. kullanabilecegimiz sekilde duzeltebilirseniz ya da bu mantik da baska bir cozum verebilirseniz cok memnun olurum. saygilar..


Sub CleanAll()
Dim rng As Range
Application.ScreenUpdating = False ' Turns off screen updating
On Error Resume Next ' Macro will continue if it encounters #N/A
'Adjust "Sheet1" and Range in Line 6
For Each rng In ActiveSheet.Range("A1:A10").Cells
rng.Value = AlphaNumericOnly(rng.Value) ' Function call
Next
Application.ScreenUpdating = True
End Sub

Function AlphaNumericOnly(strSource As String) As String
Dim i As Integer
Dim strResult As String
Dim strSource As String
On Error Resume Next
For i = 1 To Len(strSource)
Select Case Asc(Mid(strSource, i, 1))

'The numbers below match Char Codes to keep
Case 32, 35 To 47, 48 To 57, 63, 65 To 90, 92, 96, 97 To 122:
strResult = strResult & Mid(strSource, i, 1)
End Select
Next
AlphaNumericOnly = strResult
End Function
 
Aşağıdaki şekilde denedim oldu
Kod: 
Function AlphaNumericOnly(strSource As String) As String
    Dim i As Integer
    Dim strResult As String

    For i = 1 To Len(strSource)
        Select Case Asc(Mid(strSource, i, 1))
            Case 48 To 57, 32, 65 To 90, 97 To 122: '09AZaz alıyor, boşluk isterseniz 32 de ekleyin
                strResult = strResult & Mid(strSource, i, 1)
        End Select
    Next
    AlphaNumericOnly = strResult
End Function

Aşağıdaki kod ise belirtilen aralıkta yukarıdaki fonksiyonu çalıştırdığını gördüm
Kod: 
Sub CleanAll()
    Dim rng As Range

    For Each rng In Sheets("Sayfa1").Range("A1:K1500").Cells 'adjust sheetname and range accordingly
        rng.Value = AlphaNumericOnly(rng.Value)
    Next
End Sub
 
Son düzenleme:
Kod: 
Char Code Character  Char Code Character 
32 space  80 P 
33 !  81 Q 
34 “  82 R 
35 #  83 S 
36 $  84 T 
37 %  85 U 
38 &  86 V 
39 ‘  87 w 
40 (  88 X 
41 )  89 Y 
42 *  90 Z 
43 +  91 [ 
44 ,  92 \ 
45 –  93 ] 
46 .  94 ^ 
47 /  95 _ 
48 0  96 ` 
49 1  97 a 
50 2  98 b 
51 3  99 c 
52 4  100 d 
53 5  101 e 
54 6  102 f 
55 7  103 g 
56 8  104 h 
57 9  105 i 
58 :  106 j 
59 ;  107 k 
60 <  108 l 
61 =  109 m 
62 >  110 n 
63 ?  111 o 
64 @  112 p 
65 A  113 q 
66 B  114 r 
67 C  115 s 
68 D  116 t 
69 E  117 u 
70 F  118 v 
71 G  119 w 
72 H  120 x 
73 I  121 y 
74 J  122 z 
75 K  123 { 
76 L  124 | 
77 M  125 } 
78 N  126 ~ 
79 O  127 DEL
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst