• DİKKAT !

    Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı ya da giriş yapmalısınız. Foruma üye olmak Dosya Yükleme tamamen ücretsizdir.

Çözüldü İsim Gruplarının Yanına Satır Sayıları

Bu konu çözüldü olarak işaretlenmiştir. Çözülmediğini düşünüyorsanız konuyu rapor edebilirsiniz.
Durum
Konu Çözümlendiği İçin Kapatılmıştır.

hakki83

Yeni Üye
Katılım
9 Ağu 2021
Mesajlar
767
Çözümler
3
Aldığı beğeni
234
Excel V
Office 2016 TR
Konu Sahibi
Değerli hocalarım iyi günler.

2 sorum var

Birinci sorum:
Örnek dosya1’de, A sütununda isim grupları vardır.
B sütununa, tam olarak örnekteki gibi satır sayılarını makroyla otomatik oluşturabilir miyiz?

İkinci sorum:
Örnek dosya1’deki isim gruplarının arasında düzensiz boşluklar vardır.
Aralarındaki boşluğu makroyla 1 boşluk olacak şekilde oluşturabilir miyiz? (Örnek dosya2’deki gibi olacak şekilde)


İkisi ayrı sorudur, teşekkürler.
 
Çözüm
bu da tamamı modüle yapıştır
Sub islem()
Dim rg As Range
Set rg = Sayfa1.UsedRange
Dim sonsatir As Long, a As Long
a = 0
sonsatir = rg.Rows.Count
For i = sonsatir To 2 Step -1
' Eğer satırın ilk hücresi ve sonraki hücresi boş ise sil
If Len(Sayfa1.Cells(i, 1)) < 1 And Len(Sayfa1.Cells(i + 1, 1)) < 1 Then

Sayfa1.Rows(i).Delete
a = 0


End If

Next i
say
End Sub

Sub say()
sonsatir = Sayfa1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To sonsatir
If Len(Sayfa1.Cells(i, 1)) < 1 Then
For k = 1 To b
Sayfa1.Cells(i - (b - k + 1), 2) = b
Next
a = 0
Else
a = a + 1
'Aşağıdaki satırı ihtiyaç yoksa silebilirsin
Sayfa1.Cells(i, 3) = a
b = a
End If
Next i
End Sub
ikinci sorunun cevabı
HTML:
CSS:
İçeriği görebilmek için Giriş yap ya da Üye ol.
 
HTML:
Kod:
İçeriği görebilmek için Giriş yap ya da Üye ol.
hocam buda birinci için deneyiniz
 
bu da tamamı modüle yapıştır
Sub islem()
Dim rg As Range
Set rg = Sayfa1.UsedRange
Dim sonsatir As Long, a As Long
a = 0
sonsatir = rg.Rows.Count
For i = sonsatir To 2 Step -1
' Eğer satırın ilk hücresi ve sonraki hücresi boş ise sil
If Len(Sayfa1.Cells(i, 1)) < 1 And Len(Sayfa1.Cells(i + 1, 1)) < 1 Then

Sayfa1.Rows(i).Delete
a = 0


End If

Next i
say
End Sub

Sub say()
sonsatir = Sayfa1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To sonsatir
If Len(Sayfa1.Cells(i, 1)) < 1 Then
For k = 1 To b
Sayfa1.Cells(i - (b - k + 1), 2) = b
Next
a = 0
Else
a = a + 1
'Aşağıdaki satırı ihtiyaç yoksa silebilirsin
Sayfa1.Cells(i, 3) = a
b = a
End If
Next i
End Sub
 
Çözüm
Sayın askan hocaya alternatif olsun
 
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
Geri
Üst