Metne Çevir _ Kodumdaki Veri Aralığı Hatası Hk.

C

cenderus

Katılım
25 Aralık 2005
Mesajlar
104
Arkadaşlar,

Elimdeki rapor formatında bir değişiklik yaptım ama kodlarımda bir birine girdi yardımınızı rica ediyorum,

Amaç :
Genel liste sayafasındaki verileri , belli değişkenlere gore sayfara dağıtmak ve dağıtılan verileri metne çevirmek,

Mevcut durum:sayfalara dağıtma başarılı
:metne cevirme basarısız

Her Sayfada Metine Cevirelek Hucre aralığı : d33:j65536

Daha once değişecek hucre aralığım :d33:g65536 idi ve koda 3 sutun için revize ettim ama şimdi hata veriyor;

değiştiğim kod :
Kod: 
Sub donustur()
Dim i As Long, a As Long, x As Long, evn As Collection, y As Byte, z As Long
    x = Range("a65536").End(3).Row
Set evn = New Collection
    For y = 1 To Worksheets.Count
        If Sheets(y).Name <> "Sheet2" Then
            evn.Add Sheets(y).Name
        End If
    Next y
For z = 1 To evn.Count
Sheets(evn(z)).Activate
    'For i = 2 To 5'
    For i = 1 To 8
        For a = 1 To x
        'For a = 2 To x'
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "21", "a ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "22", "asa ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "23", "aa ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "24", "ab ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "20", "ac ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "19", "ad")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "18", "ae ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "17", "af ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "16", "ag ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "15", "ah ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "14", "ar")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "13", "at ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "12", "av ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "11", "ay ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "10", "aw")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "9", "ba")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "8", "bb ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "7", "bv ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "6", "bt ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "5", "bl ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "4", "bk ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "3", "by ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "2", "bu")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "1", "bo ")
        Next a
    Next i
Next z
    MsgBox "Metne Dönüştürme işlemi tamamlandı", vbInformation, "________"
End Sub
Eski kodum

Kod: 
Sub donustur()
Dim i As Long, a As Long, x As Long, evn As Collection, y As Byte, z As Long
    x = Range("a65536").End(3).Row
Set evn = New Collection
    For y = 1 To Worksheets.Count
        If Sheets(y).Name <> "Sheet2" Then
            evn.Add Sheets(y).Name
        End If
    Next y
For z = 1 To evn.Count
Sheets(evn(z)).Activate
    For i = 2 To 5
        For a = 2 To x
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "20", "Ü ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "19", "M ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "18", "Mgmask ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "17", "yalksa ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "16", "dadaezffff ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "15", "dsasaea ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "14", "dsdseeee ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "13", "fdfdtweeer ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "12", "wasasadf ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "11", "Işgtrdıooıo ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "10", "frerefff ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "9", "bgresare ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "8", "gfgfsaaaa ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "7", "dffgsdgsg ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "6", "gdsgsaaff ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "5", "fadFFAGDF ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "4", "sdassdsd ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "3", "mhjfjh ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "2", "ghdhdhdh ")
            If Left(Cells(a, i + 2).Value, 1) <> "a" Then _
                Cells(a, i + 2) = Replace(Cells(a, i + 2), "1", "uyuryey ")
        Next a
    Next i
Next z
    MsgBox "Metne Dönüştürme işlemi tamamlandı", vbInformation, " ______"
End Sub
 

Ekli dosyalar

  • 11.xls
    95.5 KB Görüntüleme: 7
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Üst