otomatik sıra no verme

[atomicf]

arkadaşlar daha öcede yazdım ama acemilikten uanlış yere yazdım herhalde
benim sorunum
1-b1 hücresine bie metin girdiğimde a1 hücresine numara vermesi ve b2 hücresine yazdığımda a2 hücresine de artarak devam etmesi boş ken yazmayacak(1,2,3 diye gidecek)
2-user formda grafiği nasıl gösteririm ilgilenenlere teşekkürederim

 

[necokara]

EK' teki dosyayı inceleyin.
Kolay gelsin

 

[atomicf]

size çok teşekkürederim tam işimi gördü

 

[N.Ziya Hiçdurmaz]

Buda makrolu çözüm.(sayfa kod bölümüne yazılacak)
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1:B65000]) Is Nothing Then Exit Sub
For sira = 1 To [B65000].End(3).Row
Range("A" & sira) = sira
Next
End Sub

 

[Necdet]

Merhaba,

1. Sorunuz için alternatif çözüm (boş satırları dikkate alıyor), A1 Hücresine aşağıdaki fonksiyonu yazınız

=IF(B1<>"";COUNTA($B$1:B1);"")
=E&#286;ER(B1<>"";BA&#286;_DE&#286;_DOLU_SAY($B$1:B1);"")

ve fonksiyonu aşağıya doğru kopyalayınız

 

[diyaar]

slm arkadaş senden rica eysem bana resimli anlatım excel anlatımlı program gonderirimisin yardım etsen sevinirim

 

[diyaar]

Merhaba,

1. Sorunuz için alternatif çözüm (boş satırları dikkate almıyor), A1 Hücresine aşağıdaki fonksiyonu yazınız

=IF(B1<>"";COUNTA($B$1:B1);"")
=EĞER(B1<>"";BAĞ_DEĞ_DOLU_SAY($B$1:B1);"")

ve fonksiyonu aşağıya doğru kopyalayınız

slm yrdım etsen sevinirim

 

[mesudiye_052]

Alternatif
=EĞER(B1>=1;(SATIRSAY($B$1:B1)-(BOŞLUKSAY($B$1:B1)));"")

 

[diyaar]

arkadaşlar yardım edermisiniz sizlerden bana
excel resimli anlatım lı program varsa sivinirim

 

[Necdet]

Yardım

slm yrdım etsen sevinirim

Hangi konuda yardım?

 

[atomicf]

teşekkürler

değerli arkadaşlar bu konuda yardım için yazan tüm arkadaşlara çok teşekkür ederim dileğim ileride bende yardım isteyenlere bilgilerimi aktarabileyim daha işin başındayım.
2.sorumuda aydınlatırsanız sevinirim.Diyelimki bir grafik oluşturdum ama bu grafiği ileri excelde (userformda )göstermek istiyorum yani başka frame içinde...

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki linki incelermisiniz.

http://www.excel.web.tr/showthread.php?t=19427

 

[Seceren]

arkadaşlar yardım edermisiniz sizlerden bana
excel resimli anlatım lı program varsa sivinirim

İnceleyiniz.

http://www.excel.web.tr/showthread.php?t=22364

 

[baydeniro]

Sayın V.Basic For Applications aşağıdaki kodun numara vermeye A2 den başlaması için ne yapmak gereklidir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1:B65000]) Is Nothing Then Exit Sub
For sira = 1 To [B65000].End(3).Row
Range("A" & sira) = sira
Next
End Sub

 

[xxcell]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B[COLOR="Red"]2[/COLOR]:B65000]) Is Nothing Then Exit Sub
For sira = [COLOR="red"]2[/COLOR] To [B65000].End(3).Row
Range("A" & sira) = sira [COLOR="red"]- 1[/COLOR]
Next
End Sub

Not. Gerçi soru bize sorulmadı ama maksat hızlı hizmet

 

[baydeniro]

Teşekkürler

Sayın xxcell ilginize çok teşekkürler. Ekte kodu uyguladım. Aynı sayfada bir kod daha var. Ancak 2 kod birarada çalışmıyor. Ayrı normal çalışıyorlar. Bir inceler misiniz !!!

 

[Seceren]

Şeklinde denedinizmi?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Intersect(Target, [B2:B65000]) Is Nothing Then Exit Sub
For sira = 2 To [B65000].End(3).Row
Range("A" & sira) = sira - 1
Next

Application.ScreenUpdating = False
On Error Resume Next
If Intersect(Target, Range("D2:d1000")) Is Nothing Then Exit Sub
sons = Sheets("F").Cells(65536, 1).End(xlUp).Row
aranan = Target.Value & Target.Offset(0, -1)
'Sheets("F").Select
For i = 1 To sons
bul = Sheets("F").Cells(i, 2) & Sheets("F").Cells(i, 3)
If bul = aranan Then

adres = Sheets("F").Cells(i, 2).Row
Target.Offset(0, 1) = Sheets("F").Cells(adres, 4)
End If

Next

End Sub

 

[xxcell]

Öncelikle Worksheet_Change olayını iki kere ayrı sub() a açamazsınız.

2 ncisi iki kodda şu satırlar birbirini zıt işliyor,
If Intersect(Target, [B2:B65000]) Is Nothing Then Exit Sub
' seçim b2:b65000 arasında değilsi çık

If Intersect(Target, Range("D2:d1000")) Is Nothing Then Exit Sub
' seçim d2:d1000 arasında değilsi çık

Bu durumda bu iki kodu alt alta doğru yazsanızda hiçbir zaman d2:d1000 arasını görmeyecektir. Çünkü daha öncesinde b2:b65000 arasında değilse çık diye bir kod olacak.

bu yüzden kodunuzu şu şekilde bütünleştirmeniz gerekmektedir.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Not Intersect(Target, [B2:B65000]) Is Nothing Then
For sira = 2 To [B65000].End(3).Row
Range("A" & sira) = sira - 1
Next
Else

Application.ScreenUpdating = False
On Error Resume Next
If Intersect(Target, Range("D2:d1000")) Is Nothing Then Exit Sub
sons = Sheets("F").Cells(65536, 1).End(xlUp).Row
aranan = Target.Value & Target.Offset(0, -1)
'Sheets("F").Select
For i = 1 To sons
bul = Sheets("F").Cells(i, 2) & Sheets("F").Cells(i, 3)
If bul = aranan Then

adres = Sheets("F").Cells(i, 2).Row
Target.Offset(0, 1) = Sheets("F").Cells(adres, 4)
End If
Next

End If


End Sub

 

[baydeniro]

Teşekkürler

Yardımcı olan tüm arkadaşlara ve sayın seceren ile sayıjn xxcell'e çok çok teşekkürler. Sağlıcakla kalın.