- Katılım
- 3 Mart 2009
- Mesajlar
- 519
- Excel Vers. ve Dili
- excel 2003 tr
Arkadaşlar kırmızı ile işaretli yer aktif halede hata veriyor, bu hatayı nasıl düzelte biliriz.
örnek dosya ektedir.
örnek dosya ektedir.
Option Explicit
Sub PROJE1()
Dim ss As Integer, say As Integer, a1 As Integer
Dim i, e, sonuc, Birlestir, maxsumum, Uzunluk, yinele, cıkart, yerinekoy
Dim shf1, shf2 As Worksheet
Dim hucre As Range
Set shf2 = Sheets("VG")
Set shf1 = Sheets("PROJE")
ss = shf1.Range("B65500").End(3).Row
shf1.Range("B3:B" & ss).ClearContents
say = Sheets("HES").ListBox1.ListCount - 1
For i = 0 To say
If Sheets("HES").ListBox1.Selected(i) = True Then
Birlestir = ""
For e = 1 To 50
If e = 1 Then
Birlestir = shf2.Cells(i + 5, e).Value
Else
maxsumum = shf2.Cells(3, e - 1).Value
Uzunluk = Len(shf2.Cells(i + 5, e - 1).Value)
cıkart = maxsumum - Uzunluk
'yinele = Application.WorksheetFunction.Rept("X", cıkart)
shf1.Cells(i + 25, e + 1).Value = cıkart
Birlestir = Birlestir & "" & shf2.Cells(i + 5, e).Value
End If
Next e
shf1.Cells(i + 3, 2).Value = Birlestir
End If
Next i
For Each hucre In shf1.Range("B3:B50")
If UCase(hucre.Value) = Empty Then
sonuc = sonuc & hucre.Value
Else
sonuc = sonuc & hucre.Value & Chr(10)
End If
Next hucre
shf1.Range("C3").Value = sonuc
Call LİSTBOX1
End Sub
