Makro ile Kaldırılacak Fiyatları Bulma

[Epakambalaj]

Excel Versiyonu

Excel 2010

Excel Sürümü

64 Bit

Excel Dili

Türkçe

Hayırlı sabahlar üstadladım

Görüntülemek için giriş yapmanız gerekmektedir.
(16 satır)

kodun devamına aşağıdaki kodu nasıl eklemeliyiz?

Görüntülemek için giriş yapmanız gerekmektedir.
(13 satır)

şimdiden çok teşekkür ediyorum

 

Excel Dosyası Kapatıldığında Otomatik Mail Gönderme

Makro ile Kayıtları Doğru Sıralama

[Ömer BARAN]

@Epakambalaj

Şöyle deneyin.
Sorun olabilecek kısım kırmızı renklendirdiğim bölümle ilgili olabilir.
O kısımla ilgili işlemin ne zaman/hangi alanda işlem yapılacağını net ifade ederseniz o kısım için de düzenleme yapılabilir.
Çünkü o kısımda, HANGİ SÜTUNDAKİ HÜCRENİN 3 sağındaki hücrede x olup olmadığının kontrol edildiğini anlayamadım.

Görüntülemek için giriş yapmanız gerekmektedir.
(31 satır)

 

[Epakambalaj]

ellerinize sağlık hocam
çok teşekkür ediyorum

 

[Epakambalaj]

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 3 Or Target.Row = 1 Then Exit Sub

If Target.Value <> Empty Then
Target.Offset(0, -2).Value = Date
End If
If Target = Empty Then Target.Offset(0, -2) = Empty
If Target = Empty Then Target.Offset(0, -1) = Empty
If Target = Empty Then Target.Offset(0, 1) = Empty
If Target = Empty Then Target.Offset(0, 2) = Empty
If Target = Empty Then Target.Offset(0, 3) = Empty
If Target = Empty Then Target.Offset(0, 4) = Empty
If Target = Empty Then Target.Offset(0, 5) = Empty

For sat = Target.Row - 1 To 1 Step -1
If Cells(sat, 3) = Target Then: Target.Offset(, 1) = Cells(sat, 4):
If Cells(sat, 3) = Target Then: Target.Offset(, 3) = Cells(sat, 6): Exit For
Next


For Each XD In Target
If IsNumeric(Application.Match(XD.Value, Sheets("Fiyat Listesi").[E:E], 0)) Then
sat = Application.Match(XD.Value, Sheets("Fiyat Listesi").[E:E], 0)
Cells(XD.Row, 7) = Sheets("Fiyat Listesi").Cells(sat, 7)
Cells(XD.Row, 8) = Sheets("Fiyat Listesi").Cells(sat, 11)
End If
Next


If Target.Column = 2 Then
If Target.Offset(0, 1).Value <> "" Then
Target.Offset(0, 3).Value = Target.Offset(0, 2).Value * Target.Value
End If
End If

End Sub


hayırlı günler @Ömer BARAN hocam

kolon 3 için kod çalışıyor
Next'in devamındaki kolon 2 için kodu nasıl çalıştırabiliriz acaba?

 

[Epakambalaj]

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 3 Or Target.Row = 1 Then Exit Sub

If Target.Value <> Empty Then
Target.Offset(0, -2).Value = Date
End If
If Target = Empty Then Target.Offset(0, -2) = Empty
If Target = Empty Then Target.Offset(0, -1) = Empty
If Target = Empty Then Target.Offset(0, 1) = Empty
If Target = Empty Then Target.Offset(0, 2) = Empty
If Target = Empty Then Target.Offset(0, 3) = Empty
If Target = Empty Then Target.Offset(0, 4) = Empty
If Target = Empty Then Target.Offset(0, 5) = Empty

For sat = Target.Row - 1 To 1 Step -1
If Cells(sat, 3) = Target Then: Target.Offset(, 1) = Cells(sat, 4):
If Cells(sat, 3) = Target Then: Target.Offset(, 3) = Cells(sat, 6): Exit For
Next


For Each XD In Target
If IsNumeric(Application.Match(XD.Value, Sheets("Fiyat Listesi").[E:E], 0)) Then
sat = Application.Match(XD.Value, Sheets("Fiyat Listesi").[E:E], 0)
Cells(XD.Row, 7) = Sheets("Fiyat Listesi").Cells(sat, 7)
Cells(XD.Row, 8) = Sheets("Fiyat Listesi").Cells(sat, 11)
End If
Next


If Target.Column = 2 Then
If Target.Offset(0, 1).Value <> "" Then
Target.Offset(0, 3).Value = Target.Offset(0, 2).Value * Target.Value
End If
End If

End Sub


hayırlı günler @Ömer BARAN hocam

kolon 3 için kod çalışıyor
Next'in devamındaki kolon 2 için kodu nasıl çalıştırabiliriz acaba?

kodumuz mal giriş sayfasında çalışıyor

bu çalışan kodun devamında

If Target.Column = 2 Then
If Target.Offset(0, 1).Value <> "" Then
Target.Offset(0, 3).Value = Target.Offset(0, 2).Value * Target.Value
End If
End If

bu kodun çalışmasını istiyoruz

 

[Ömer BARAN]

@Epakambalaj

Kodlarınızı/işlemleri çok incelemedim, örnek belgenizi de indirmedim.
En üsste yer alan ......... Then Exit Sub satırını aşağıdaki gibi değiştirerek deneyin.

Görüntülemek için giriş yapmanız gerekmektedir.
(1 satır)