Otomatik Satır numarası aldırmak ( VBA code )

[mrt]

Selamlar,

Yapmış olduğum bir çalışmada giriş sayfasında bulunan A7:K31 hücre
değerlerini Kopyalayıp Giriş sayfası D4 hücresinde belirtilen isme ait sayfada B sutunun en alt satırından başlayarak yapıştırıyorum.

Yapıştırma işlemi yapılan sayfada Dolu olan Her B sutunu hücresinin yanında ( A sutunu )Sıra numarası çıkmasını istiyorum.

Þuan bunu formulle yapıyorum fakat Excel'i kasıyor.

A4 hücresine "" =EÐER(B3>0,A3+1,"") ""
formulunu yazdım.

Teşekkürler.

 

[Kemal Demir]

Sub Bkolonudoluisesıranover()
For c = 3 To 50
If Cells(c, 2).Value = "" Then
Else
Cells(c, 1).Value = c
End If
Next
End Sub

umarım ıstedını bole bırseydır

Þayet direkt sırano vereceksen

Sub Sırano()
For c = 3 To 50
Cells(c, 1).Value = c
Next
End Sub

Kolay Gelsin.

 

[Levent Menteşoğlu]

Verilerinizi aktardığınız kodlarınızı verirmisiniz. Sıra nosu hangi satırdan başlamaktadır.

 

[mrt]

A3 hücresi 1. sıra olacak.



Sub hareketler()
'
' hareketler Makro
' Makro x tarafından 26.09.2005 tarihinde kaydedildi.
'


Application.Run "sayac"


Sheets("giris").Select
If Range("c4").Value = "" Then
MsgBox "Müşteri - Satıcı kodu Girmelisiniz !"
Exit Sub
End If
MsgBox "Kolay Gelsin."


Sheets("giris").Select
Range("A7:K31").Select

Selection.Copy
Sheets("hareketler").Select
Range("B2").Select
Selection.End(xlDown).Select
Cells(Selection.Row + 1, Selection.Column).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("M3:M65500").Select
ActiveCell.FormulaR1C1 = IF(RC[-3]=""çıkış"",(RC[-10]*-1),RC[-10]=
Calculate

Range("M3:M65500").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False


cevap = MsgBox("ÇIKTI İSTİYORMUSUNUZ ?", vbYesNo)
If cevap = 6 Then

Sheets("yazdır").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$34"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveSheet.PageSetup.PrintArea = ""
Sheets("giris").Select


MsgBox "ÇIKTI ALINIYOR"

Else
MsgBox "ÇIKTI ALINMADI!"
End If



Application.Run "sayfaekle"

Sheets("giris").Select
MsgBox "Verileriniz Kaydedildi"
cevap = MsgBox("Giriş Sayfası Temizlenecek", vbYesNo)
If cevap = 6 Then
Sheets("giris").Select
Range("A7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("C4").Select
Selection.ClearContents
Range("E7:E31").Formula = "0"
Range("B7:B31").Formula = "0"
Else
MsgBox "Veriler Temizlenmedi!"
End If

'ActiveWorkbook.Save

End Sub

 

[Kemal Demir]

Sub Sırano()
For c = 3 To 50
Cells(c, 1).Value = c -2
Next
End Sub

zannedersem işinizi görür

 

[mrt]

Selamlar,

Sevgili Rakkas,

İlk hareketleri kopyaladığımda çalışıyor.

Fakat tekrar veri kopyaladığımda çalışmıyor.

B sutunu dolu ise A sutununa sıra no yazmalı.

B500 hücresi dolu ise A500 hücresine 498 yazmalı.

Teşekkürler.

 

[mrt]

Ã?ZÜR DİLERİM,

3 to 50 'de değişiklik yapmayı atlamışım. Þu an ok

aynı mantıkla aşağıdaki formulleride VBA kodu olarak yazabilir miyiz ?

M3:M65536 hücrelerinde çalışacak.
ActiveCell.FormulaR1C1 = IF(RC[-3]=""çıkış"",(RC[-10]*-1),RC[-10]

U3:U65536 hücrelerinde çalışacak.
ActiveCell.FormulaR1C1 = "=IF(RC[-2]=""TEDİYE"",RC[-1]*-1,RC[-1])"

 

[Kemal Demir]

Sn. Mrt Dosyayı Yollama Gibi Bir İmkanınız varmı (İçeriği aynı olmasa da olur bir kaç örnek için
Saygılar.

 

[mrt]

Ornek

Selamlar,
Dosyayı yeterince küçültemiyorum.
Kuşa çevirip Sıkıştırdığım halde 704 kb

 

[mrt]

sizin kodları değiştirerek aşağıdaki kodu yazdım.

10. kolondaki veri çıkış ise çalışıyor, giriş ise çalışmıyor.

Muhakkak yanlış yaptığım birşey var.

Sub Hesapla()

For c = 3 To 65536

If Cells(c, 10).Value > 0 Then

ElseIf Cells(c, 10).Value = "çıkış" Then
Cells(c, 13).Value = Cells(c, 7) * -1
Else
Cells(c, 13).Value = Cells(c, 7).Value
End If
Next

End Sub

 

[Levent Menteşoğlu]

Sıra nosu için aşağıdaki koduda alternatif olarak denebilirsiniz.

[vb:1:619b92d631]Set s1 = Sheets("" & [d4])
say = s1.[b65536].End(3).Row
s1.[a3] = 1
s1.[a4] = 2
s1.[a3:a4].AutoFill Destination:=s1.Range("A3:A" & say)
[/vb:1:619b92d631]