Kelimeye göre rakam

[muratgunay48]

Arkadaşlar, sayın hocalarım. Çalıştığım iş yerinde bir liste var. Fiyatlar.
En mantıklısı şöyle anlatayım, veresiye defteri var düşünelim. Çok fazla çeşit mal yok zaten.
Elma, armut, kayısı, muz, şeftali
Bu liste 3 yıldır güncellenmemiş. Mallar A4:E1445 arasında. 3 yıl yıl önce elma 1 liraymış. Onu güncelleyeceğim.
Fiyat malın 1 satır altında yazıyor. Mesela A4 elma A5 parası.
A4:E1445 arasında tüm elmaların 1 satır altına 50yaz diyeceğiz.
Nasıl yapılır acaba?
Şimdiden teşekkür ederim.
Saygılarımla.

 

[Muhammet Okumuş]

Merhaba,

Sub Elma()
Application.ScreenUpdating = False
For i = 4 To 1445
For j = 1 To 5
If Cells(i, j) = "Elma" Then Cells(i + 1, j) = 50
Next
Next
End Sub

kodu deneyiniz.

 

[Korhan Ayhan]

Merhaba,

Alternatif... Daha hızlı sonuç verebilir..

Option Explicit

Sub Update_Unit_Price()
    Dim Rng As Range, Product As Range
    Dim Product_Name As String
    Dim Product_Price As String
    Dim New_Price As Double
    
    Product_Name = Trim(LCase(InputBox("Lütfen birim fiyatı güncellenecek malzemenin adını giriniz...", "Malzeme Adı")))
    If Product_Name = "" Then Exit Sub
    
    Product_Price = Trim(InputBox("Lütfen malzemenin yeni birim fiyatını giriniz...", "Birim Fiyat"))
    If Product_Price = "" Then Exit Sub

    If Not IsNumeric(Product_Price) Then
        MsgBox "Geçerli bir sayısal değer girilmedi!", vbCritical
        Exit Sub
    End If
    
    New_Price = CDbl(Replace(Product_Price, ".", ","))
    
    For Each Rng In Range("A4:E1445")
        If LCase(Rng.Value) = Product_Name Then
            If Product Is Nothing Then
                Set Product = Rng
            Else
                Set Product = Union(Product, Rng)
            End If
        End If
    Next

    If Not Product Is Nothing Then
        Product.Offset(1).Value = New_Price
        MsgBox "Aranan Malzeme ; " & Product_Name & vbCrLf & vbCrLf & "Birim fiyatları güncellenmiştir."
    Else
        MsgBox "Aranan Malzeme ; " & Product_Name & vbCrLf & vbCrLf & "Bulunamadı!", vbExclamation
    End If
End Sub

 

[muratgunay48]

Merhaba,

Alternatif... Daha hızlı sonuç verebilir..

Option Explicit

Sub Update_Unit_Price()
    Dim Rng As Range, Product As Range
    Dim Product_Name As String
    Dim Product_Price As String
    Dim New_Price As Double
   
    Product_Name = Trim(LCase(InputBox("Lütfen birim fiyatı güncellenecek malzemenin adını giriniz...", "Malzeme Adı")))
    If Product_Name = "" Then Exit Sub
   
    Product_Price = Trim(InputBox("Lütfen malzemenin yeni birim fiyatını giriniz...", "Birim Fiyat"))
    If Product_Price = "" Then Exit Sub

    If Not IsNumeric(Product_Price) Then
        MsgBox "Geçerli bir sayısal değer girilmedi!", vbCritical
        Exit Sub
    End If
   
    New_Price = CDbl(Replace(Product_Price, ".", ","))
   
    For Each Rng In Range("A4:E1445")
        If LCase(Rng.Value) = Product_Name Then
            If Product Is Nothing Then
                Set Product = Rng
            Else
                Set Product = Union(Product, Rng)
            End If
        End If
    Next

    If Not Product Is Nothing Then
        Product.Offset(1).Value = New_Price
        MsgBox "Aranan Malzeme ; " & Product_Name & vbCrLf & vbCrLf & "Birim fiyatları güncellenmiştir."
    Else
        MsgBox "Aranan Malzeme ; " & Product_Name & vbCrLf & vbCrLf & "Bulunamadı!", vbExclamation
    End If
End Sub

Hocam emeğinize sağlık. Önceden sormadan çalıştırmak istemedim. Sayfanın kod bölümüne yazsam diğer sayfaları bozmaz değil mi? Çünkü aynı ürünler diğer sayfalarda da var. Ama onlar değişsin istemiyorum.

 

[muratgunay48]

Merhaba,

Sub Elma()
Application.ScreenUpdating = False
For i = 4 To 1445
For j = 1 To 5
If Cells(i, j) = "Elma" Then Cells(i + 1, j) = 50
Next
Next
End Sub

kodu deneyiniz.

Hocam emeğinize sağlık.
Sub Elma()
Application.ScreenUpdating = False
For i = 4 To 1445
For j = 1 To 5
If Cells(i, j) = "Elma" Then Cells(i + 1, j) = 50
If Cells(i, j) = "Armut" Then Cells(i + 1, j) = 60
If Cells(i, j) = "Muz" Then Cells(i + 1, j) =90
Next
Next
End Sub

Şeklinde mi olacak?

 

[Korhan Ayhan]

Hocam emeğinize sağlık. Önceden sormadan çalıştırmak istemedim. Sayfanın kod bölümüne yazsam diğer sayfaları bozmaz değil mi? Çünkü aynı ürünler diğer sayfalarda da var. Ama onlar değişsin istemiyorum.

Kod tek sayfada (aktif sayfa) çalışmaktadır.

 

[Muhammet Okumuş]

Hocam emeğinize sağlık.
Sub Elma()
Application.ScreenUpdating = False
For i = 4 To 1445
For j = 1 To 5
If Cells(i, j) = "Elma" Then Cells(i + 1, j) = 50
If Cells(i, j) = "Armut" Then Cells(i + 1, j) = 60
If Cells(i, j) = "Muz" Then Cells(i + 1, j) =90
Next
Next
End Sub

Şeklinde mi olacak?

Evet. i+1 alt satırı j+1 sağ hücreyi değiştirir.

 

[muratgunay48]

Kod tek sayfada (aktif sayfa) çalışmaktadır.

Teşekkür ederim hocam