Hücre Değerini Değiştirme

[nx7]

Elimde aşağıdaki gibi bir excel var. A-B-C ürünleri sayıları ile mevcut. A ürününün en yüksek sayısını bulup, A ürününün diğer sayılar ile değiştirmek istiyorum.

A	99
A	99
A	199
A	429
B	399
B	299
C	699
C	799
C	699
C	699
C	699

Sub TestCountIf()
Range("S2") = WorksheetFunction.CountIf(Range("C2:C10688"), Range("C2"))
Range("S3") = WorksheetFunction.Max(Range("J2:J5"))
Range("J2:J5").Replace What:="299", Replacement:="450"
End Sub

Yazdığım kodda S2 hücresine C2 ila C10688 arasındaki hücrelerde C2 hücresinin kaç tane olduğunu aratıyorum. (Tablomda 4 adet var, bu sebeple S2 hücresine 4 yazıyıyor.)
Daha sonra S3 hücresinde J2 ve sonraki 3 hücredeki (toplamda 4 hücre, çünkü bir önceki komut 4 adet buldu. Eğer 10 adet bulsaydı 10 tane hücre isteyecektim.) maksimum sayıyı yazdırıyorum. Bu sayıyı da C2-C3-C4 ve C5 hücresindeki değerler değiştirmek istiyorum.

Ama yaşadığım sorun şu; ben burada J2'den sonra 4 tane hücre olduğunu gördüğüm için elimde J5 yazdım. Burada J5 yazmadan, excel bana 4 tekrar olduğu için 4 tane hücrenin içinde maksimum değeri bulmasını ve bu değeri de sadece 4 tane hücrede değiştirmesini istiyorum. Daha sonra C6'ya bakıp orada yazan değerin kaç tane tekrar ettiğini görüp (diyelim 2 kere tekrar ediyor) bu ettiği tekrardan dolayı eşit olduğu sayılardan maksimumu bulup diğer hücrelerini de değiştirmesini istiyorum.

Aklıma ForNext döngüsü de geldi ama tüm gün uğraşıp bir çözüm bulamadım.
Umarım derdimi açıklayabildim. Şimdiden yardımlarınız için teşekkür ederim.
İyi forumlar

 

[DoğanD]

Merhaba,

AD ve AE hücrelerinde veriniz yok ise aşağıdaki tabloyu kullanabilirsiniz. Öncelikle kendince bir tablo oluşturup her ürün için en büyük değeri oraya yazıyor ve ardından düşeyara yaparak tüm verilerin en büyüklerini getiriyor. 10B satırlık bir veri için hızlı bir çözüm olabileceğini düşünüyorum. Yine de Array'lar ile bir çözüm gelirse onu önceleyebilirsiniz.

Edit: Hedef Hücreyi değiştirdim.

Sub dd()
Dim ss, i As Integer
ss = 2
Range("Ad2:ad" & Range("ad" & Rows.Count).End(xlUp).Row + 1).ClearContents
For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
If WorksheetFunction.CountIf(Range("AD:AD"), Cells(i, 3)) = 0 Then
Cells(ss, 30) = Cells(i, 3)
ss = ss + 1
End If
If Cells(i, 4) > Cells(WorksheetFunction.Match(Cells(i, 3), Range("AD:AD"), 0), 31) Then
Cells(WorksheetFunction.Match(Cells(i, 3), Range("AD:AD"), 0), 31) = Cells(i, 4)
End If
Next i
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],C[20]:C[21],2,0)"
    Selection.AutoFill Destination:=Range("J2:J" & i - 1)
Range("J2:J" & i - 1).Copy
Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

 

[nx7]

Sen harika bir insansın Teşekkür ederim