A sütunu ile B sütunu çarpımını d ye yazdırma

[jambow]

Sub Carp()
Range("D1") = Range("A1") * Range("B1")
Range("D1").Formula = "=(A1 * A1)"
End Sub


arkadaşlar bu formul hücre bazında çarpıyor bana gerekli olan sutunların çarpımı
örnek:
a1*b1=d1
a2*b2=d2
a3*b3=d3
a4*b4=d4
...........
a65536*b65536=d65536

makro ile bunu nasıl yaparız

 

[Ayhan Ercan]

For i = 1 to 65536
Cells(i,4)=Cells(i,1) * Cells(i,2)
Next

 

[N.Ziya Hiçdurmaz]

yanıt

Sub carp()
Dim sat As Integer
For sat = 1 To Cells(65536, "a").End(xlUp).Row
Cells(sat, "d") = Cells(sat, "a") * Cells(sat, "b")
Next
End Sub

 

[jambow]

teşekkürler arkadaşım

 

[Ali]

arkadaşlar bu formul hücre bazında çarpıyor bana gerekli olan sutunların çarpımı
örnek:
a1*b1=d1
a2*b2=d2
a3*b3=d3
a4*b4=d4
...........
a65536*b65536=d65536

makro ile bunu nasıl yaparız

İlgili sayfanızın kod bölümüne ekleyiniz.

Dim basla
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target = 0 Then Exit Sub
If basla = Target Then Exit Sub
If Target.Column = 1 Then
Target.Offset(0, 3) = Target * Target.Offset(0, 1)
End If
If Target.Column = 2 Then
Target.Offset(0, 2) = Target * Target.Offset(0, -1)
End If
End Sub

 

[jambow]

tşekkürler

 

[mami68]

İkinci bir verziyonu.
Hangi sayfada çarpım yaparsan netice gelecektir.
Makroyu çalıştırmaya gerek yok.
Bu kodu Thisworkbook bölümüne kopyalayın.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sat As Integer
For sat = 1 To Cells(65536, "a").End(xlUp).Row
Cells(sat, "d") = Cells(sat, "a") * Cells(sat, "b")
Next
End Sub

 

[jambow]

abi şu makroyu bir türlü üyeler isimli sayfada çalıştıramadım

For i = 1 to 65536
Cells(i,4)=Cells(i,1) * Cells(i,2)
Next

 

[Orion1]

İkinci bir verziyonu.
Hangi sayfada çarpım yaparsan netice gelecektir.
Makroyu çalıştırmaya gerek yok.
Bu kodu Thisworkbook bölümüne kopyalayın.
Kodlar thisworkbook modülüne kopyalanacaktır.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sat As Integer
For sat = 1 To Cells(65536, "a").End(xlUp).Row
Cells(sat, "d") = Cells(sat, "a") * Cells(sat, "b")
Next
End Sub

Sayın mami68;
Doğrusu aşağıdaki gibidir.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, [A:B]) Is Nothing Then Exit Sub
On Error Resume Next
Cells(Target.Row, "D").Value = Cells(Target.Row, "A").Value * Cells(Target.Row, "B").Value
End Sub

 

[mami68]

Hocam eline sağlık,bunuda sayenizde öğreniyoruz.

 

[Orion1]

abi şu makroyu bir türlü üyeler isimli sayfada çalıştıramadım

For i = 1 to 65536
Cells(i,4)=Cells(i,1) * Cells(i,2)
Next

Üyeler adlı sayfa sekmesine sağ tıklayın.
Kodu görüntüleyitıklayın
Açılan pencerye aşağıdaki kodları yapıştırın.Pencreyi kapatın işlem tamamdır.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:B]) Is Nothing Then Exit Sub
On Error Resume Next
Cells(Target.Row, "D").Value = Cells(Target.Row, "A").Value * Cells(Target.Row, "B").Value
End Sub