• DİKKAT

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

Birleştirme ile ilgili bir makro

Katılım
28 Kasım 2007
Mesajlar
919
Excel Vers. ve Dili
Office 2010 İngilizce
Merhaba arkadaşlar,

H kolonumda bir takım değerlerim var bazısı 1 karakter bazısıda 2, bazı hücrelerde ise text olarak veri var. Benim amacım 1 karakrese başlarına 3 tane sıfır 0 koyuyaorum iki karakterse 2 sıfır 0 koyuyorum, text ise hücrenin kendisini alıyorum. Bunuda şu formülle alıyorum.
=IF(ISTEXT(H26)=TRUE;H26;IF(LEN(H26)=1;CONCATENATE(0;0;0;H26);CONCATENATE(0;0;H26)))

Bunun için bir koda nasıl çevirebilirim yardımcı olur musunuz?
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For i = 1 To 1000
If Len(Range("h" & i).Text) = 1 Then Range("h" & i).Value = "00" & Range("h" & i).Text
If Len(Range("h" & i).Text) = 2 Then Range("h" & i).Value = "0" & Range("h" & i).Text
Next
End Sub
istediginiz bu olabilirmi?
 

Ekli dosyalar

sorunuzdaki bir detayı atlamışım hücredeki metinse değişmiyecekse:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For i = 1 To 1000
If IsNumeric(Range("h" & i).Text) Then
If Len(Range("h" & i).Text) = 1 Then Range("h" & i).Value = "00" & Range("h" & i).Text
If Len(Range("h" & i).Text) = 2 Then Range("h" & i).Value = "0" & Range("h" & i).Text
Else
End If
Next
End Sub

bunu kullanabilirsiniz.iyi çalışmalar.
 
Sub BIRLESTIR()
For k = 2 To WorksheetFunction.CountA(Range("H:H"))
If IsText(Cells(k, 8).Text) = True Then
Cells(k, 8).Value = Cells(k, 8).Value
ElseIf Cells(k, 8).Value = 1 Then
Cells(k, 8).Value = "000" & Range(8, 7)
ElseIf Cells(8, 7).Value = 2 Then
Cells(k, 8).Value = "00" & Range(k, 8)
End If
Next k
End Sub

Sizinkinle çalıştıramadım üstadım. Ben bir şeyler yaptım ama yine olmadı yardımcı olur musunuz?
 
Sub BIRLESTIR()
For k = 2 To WorksheetFunction.CountA(Range("H:H"))
If IsNumeric(Cells(k, 8).Text) = False Then
Cells(k, 8).Value = Cells(k, 8).Value
ElseIf Len(Cells(k, 8).Text) = 1 Then
Cells(k, 8).Value = "000" & Cells(k, 8)
ElseIf Len(Cells(k, 8).Text) = 2 Then
Cells(k, 8).Value = "00" & Cells(k, 8)
End If
Next k
End Sub

pardon yanlış kodu kopyalamışım.
 
ekteki dosyayı inceleyin anlattıgınızı yapıyor.yalnız baştaki sıfırlar kalması için h sütununu metin olarak biçimlendirin.
 

Ekli dosyalar

Geri
Üst