konas06
Altın Üye
- Katılım
- 27 Kasım 2007
- Mesajlar
- 661
- Excel Vers. ve Dili
- ofis 2016 Türkçe
- Altın Üyelik Bitiş Tarihi
- 01-07-2025
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub yatayi_dikey_yap()
sonsatir = Cells(Rows.Count, "F").End(3).Row
If sonsatir < 5 Then sonsatir = 5
sonsutun = Cells(4, Columns.Count).End(xlToLeft).Column
If sonsutun < 10 Then Exit Sub
Range("G5:H" & sonsatir).ClearContents
For i = 10 To sonsutun
isimref = Cells(4, i).Value
For i1 = 5 To sonsatir
rakam = Cells(i1, i).Value
isim = Cells(i1, "G").Value
If isim <> "" Then GoTo atla
If rakam <> "" Then
Cells(i1, "G").Value = isimref
Cells(i1, "H").Value = rakam
End If
atla:
Next i1
Next i
End Sub
Sub dikey_yatay_yap()
isimler = "/"
sonsatir = Cells(Rows.Count, "G").End(3).Row
sonsutun = Cells(4, Columns.Count).End(xlToLeft).Column
If sonsutun < 9 Then sonsutun = 9
Range(Cells(4, "J"), Cells(sonsatir, sonsutun)).Clear
sonsutun = Cells(4, Columns.Count).End(xlToLeft).Column
If sonsutun < 9 Then sonsutun = 9
For i = 5 To sonsatir
isimref = Cells(i, "G").Value
If InStr(isimler, isimref) > 0 Then GoTo atla
sonsutun = sonsutun + 1
Cells(4, sonsutun).Value = isimref
isimler = isimler & isimref & "/"
Range("H5:H" & sonsatir).Copy Cells(5, sonsutun)
For i1 = 5 To sonsatir
isim = Cells(i1, "G").Value
If isimref <> isim Then
Cells(i1, sonsutun).Value = ""
End If
Next i1
atla:
Next i
End Sub
Sub numaralandır()
sonsatir = Cells(Rows.Count, "G").End(3).Row
If sonsatir < 5 Then sonsatir = 5
Range("H5:H" & sonsatir).ClearContents
liste = Range("F5:H" & sonsatir)
For i = 1 To UBound(liste)
il = liste(i, 1)
isim = liste(i, 2)
buldu = False
For i1 = 1 To UBound(liste)
il2 = liste(i1, 1)
isim2 = liste(i1, 2)
If il = il2 And isim = isim2 And liste(i1, 3) <> "" Then
sonrakam = liste(i1, 3)
buldu = True
Exit For
End If
Next i1
If buldu Then
liste(i, 3) = sonrakam
Else
sonrakam = 0
For i1 = 1 To UBound(liste)
il2 = liste(i1, 1)
isim2 = liste(i1, 2)
If isim = isim2 And (liste(i1, 3) >= sonrakam Or sonrakam = 0) Then
sonrakam = liste(i1, 3) + 1
End If
Next i1
liste(i, 3) = sonrakam
End If
Next i
Range("F5:H" & sonsatir).Resize(sonsatir - 4) = liste
End Sub
Hocam çok teşekkür ederim,Biraz kolaya kaçtım. Sağlama yapmak için zamanım yok.
Kontrol ediniz.
C#:Sub numaralandır() sonsatir = Cells(Rows.Count, "G").End(3).Row If sonsatir < 5 Then sonsatir = 5 Range("H5:H" & sonsatir).ClearContents liste = Range("F5:H" & sonsatir) For i = 1 To UBound(liste) il = liste(i, 1) isim = liste(i, 2) buldu = False For i1 = 1 To UBound(liste) il2 = liste(i1, 1) isim2 = liste(i1, 2) If il = il2 And isim = isim2 And liste(i1, 3) <> "" Then sonrakam = liste(i1, 3) buldu = True Exit For End If Next i1 If buldu Then liste(i, 3) = sonrakam Else sonrakam = 0 For i1 = 1 To UBound(liste) il2 = liste(i1, 1) isim2 = liste(i1, 2) If isim = isim2 And (liste(i1, 3) >= sonrakam Or sonrakam = 0) Then sonrakam = liste(i1, 3) + 1 End If Next i1 liste(i, 3) = sonrakam End If Next i Range("F5:H" & sonsatir).Resize(sonsatir - 4) = liste End Sub
Tabiki tercih sizin.Hocam çok teşekkür ederim,
Ancak bunu kendi dosyama uygulamam çok vaktimi alacak.
Formül ile kolay uyarlanabilir bir çözüm daha faydalı olacaktır.
Ancak alternatif bulmazsam mecbur değerlendireceğim.
Teşekkürler.
Haluk Hocam, bir şey yanlış anlaşıldı."Google Sheets" ile alternatif:
Ekli dosyayı görüntüle 223409
E1 hücresindeki formül:
Kod:={"";A2:A}
F1 hücresindeki formül:
Kod:=TRANSPOSE(UNIQUE(B2:B))
F2 hücresine de aşağıdaki formülü girip, sağa ve aşağıya doğru sürükleyin;
Kod:=IF(($B3=F$1)*$C3>0;($B3=F$1)*$C3;"")
.
Haluk bey bende aynı yanlış anlamayı yaşadım.Ne demek istiyorsunuz, anlamadım ..... Benim resimdeki A2:C10 hücreleri olmadan, E1:I10 aralığındaki tablo yapılamaz ama, başka bir sayfada oluşturulabilir.
.
Hmmmm..... şimdi anladım !Haluk bey bende aynı yanlış anlamayı yaşadım.C sütunundaki numaralandırmayı silin ve formüller ile yeniden oluşturun.
E sütunu ve sonrasını dikkate almayın.
Teşekkür ederim.Haluk bey bende aynı yanlış anlamayı yaşadım.C sütunundaki numaralandırmayı silin ve formüller ile yeniden oluşturun.
E sütunu ve sonrasını dikkate almayın.
=TOPLA(EĞER(SIKLIK(EĞER(($G$5:G5=G5);KAÇINCI($F$5:F5;$F$5:F5;0));SATIR($F$5:F5)-4)>0;1))