-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Satır ekleme kodu hk.
- Konbuyu başlatan mcleren
- Başlangıç tarihi
- Katılım
- 15 Mart 2005
- Mesajlar
- 42,738
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Selamlar,
Aşağıdaki şekilde denermisiniz.
Aşağıdaki şekilde denermisiniz.
Kod:
Sub YEDİ_SATIR_EKLE()
For X = [A65536].End(3).Row To 3 Step -1
If Cells(X, 1) <> Cells(X - 1, 1) Then Rows(X & ":" & X + 7).Insert shift:=xlDown
Next
End Sub- Katılım
- 15 Mart 2005
- Mesajlar
- 42,738
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Selamlar,
Mamülleriniz hep 7 satırlık verilerden mi oluşuyor ?
Mamülleriniz hep 7 satırlık verilerden mi oluşuyor ?
- Katılım
- 15 Mart 2005
- Mesajlar
- 42,738
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Selamlar,
Ekteki örnek dosyayı incelermisiniz.
Ekteki örnek dosyayı incelermisiniz.
- Katılım
- 15 Mart 2005
- Mesajlar
- 42,738
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Selamlar,
Örnek dosyadaki kodu aşağıdaki ile değiştirip denermisiniz.
Örnek dosyadaki kodu aşağıdaki ile değiştirip denermisiniz.
Kod:
Sub YEDİ_SATIR_EKLE_TOPLAM_AL()
BAŞLIK = [A1:J1]
For X = [A65536].End(3).Row To 3 Step -1
If Cells(X, 1) <> Cells(X - 1, 1) Then
Rows(X & ":" & X + 7).Insert shift:=xlDown
Range(Cells(X + 7, "A"), Cells(X + 7, "J")) = BAŞLIK
End If
Next
For Each ALAN In Columns("I").SpecialCells(xlConstants, xlNumbers).Areas
ADRES1 = ALAN.Address(False, False)
ADRES2 = ALAN.Offset(0, 1).Address(False, False)
ALAN.Offset(ALAN.Count + 1, -8).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -8).Resize(1, 1)
ALAN.Offset(ALAN.Count + 2, -8).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -8).Resize(1, 1)
ALAN.Offset(ALAN.Count + 3, -8).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -8).Resize(1, 1)
ALAN.Offset(ALAN.Count + 1, -7).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -7).Resize(1, 1)
ALAN.Offset(ALAN.Count + 2, -7).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -7).Resize(1, 1)
ALAN.Offset(ALAN.Count + 3, -7).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -7).Resize(1, 1)
ALAN.Offset(ALAN.Count, -1).Resize(1, 1).Formula = "TOPLAM"
ALAN.Offset(ALAN.Count, 0).Resize(1, 1).Formula = "=SUM(" & ADRES1 & ")"
ALAN.Offset(ALAN.Count, 1).Resize(1, 1).Formula = "=SUM(" & ADRES2 & ")"
Next
End Sub- Katılım
- 11 Mayıs 2005
- Mesajlar
- 167
- Excel Vers. ve Dili
-
office 2003 tr & eng.
office 2007 tr & eng.
b sütünundaki hücreler dolu ise hücre ekle
Sub saga_kaydir()
Application.ScreenUpdating = False
Dim i As Integer
t = ActiveSheet.UsedRange.Rows.Count
For i = t To 1 Step -1
If Left(Cells(i, 2), 1) <> "" Then
Rows(i).Insert Shift:=xlToRight
End If
Next i
Application.ScreenUpdating = True
End Sub
kodunda birşeyleri yanlış yapıyorum.
satır ekliyor. alta kaydırıyor.
ben b kolunu dolu ise 1 hücre eklesin ve sağa kaydırsın istiyoeum.
Sub saga_kaydir()
Application.ScreenUpdating = False
Dim i As Integer
t = ActiveSheet.UsedRange.Rows.Count
For i = t To 1 Step -1
If Left(Cells(i, 2), 1) <> "" Then
Rows(i).Insert Shift:=xlToRight
End If
Next i
Application.ScreenUpdating = True
End Sub
kodunda birşeyleri yanlış yapıyorum.
satır ekliyor. alta kaydırıyor.
ben b kolunu dolu ise 1 hücre eklesin ve sağa kaydırsın istiyoeum.
- Katılım
- 15 Mart 2005
- Mesajlar
- 42,738
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Selamlar,
Kodunuzu aşağıdaki şekilde değiştirip denermisiniz.
Kodunuzu aşağıdaki şekilde değiştirip denermisiniz.
Kod:
Sub SAĞA_KAYDIR()
Application.ScreenUpdating = False
Dim X As Integer
ALAN = ActiveSheet.UsedRange.Rows.Count
For X = ALAN To 1 Step -1
If Cells(X, 2) <> "" Then
Cells(X, 2).Insert Shift:=xlToRight
End If
Next
Application.ScreenUpdating = True
End Sub
Son düzenleme:
Satır ekleme ve Yapıştırma
Merhaba Arkadaşlar;
Foruma yeni üye oldum. Aramalarım sonucunda benim için zor olanları kolaylaştıran çözümlere sizlerin sayesinde ulaştım. Emeği geçen herkese teşekkürler...
----
Sub YirmiAltı_SATIR_EKLE()
For X = [A65536].End(3).Row To 3 Step -1
If Cells(X, 1) <> Cells(X - 1, 1) Then Rows(X & ":" & X + 26).Insert shift:=xlDown
Next
End Sub
-----
yukarıdaki kodu makro haline getirmekle birlikte yaptıramadığım birkaç sorunum var: eklenen satırlardan önce bulunan A sütunundaki ismin yeni eklenen satırlarında da A sütununda da yer alması ve toplamda aynı isimden 27 tane olması.
AAAA
AAAA
AAAA
...
..
BBBB
BBBB
gibi....
Diğer sorunum da; yeni eklenen satırlarda yer alan B den AA sütunlarına kadar kopyalayaladığım aynı formülleri yapıştırmak..
İlginiz için çok teşekkür ederim....
Merhaba Arkadaşlar;
Foruma yeni üye oldum. Aramalarım sonucunda benim için zor olanları kolaylaştıran çözümlere sizlerin sayesinde ulaştım. Emeği geçen herkese teşekkürler...
----
Sub YirmiAltı_SATIR_EKLE()
For X = [A65536].End(3).Row To 3 Step -1
If Cells(X, 1) <> Cells(X - 1, 1) Then Rows(X & ":" & X + 26).Insert shift:=xlDown
Next
End Sub
-----
yukarıdaki kodu makro haline getirmekle birlikte yaptıramadığım birkaç sorunum var: eklenen satırlardan önce bulunan A sütunundaki ismin yeni eklenen satırlarında da A sütununda da yer alması ve toplamda aynı isimden 27 tane olması.
AAAA
AAAA
AAAA
...
..
BBBB
BBBB
gibi....
Diğer sorunum da; yeni eklenen satırlarda yer alan B den AA sütunlarına kadar kopyalayaladığım aynı formülleri yapıştırmak..
İlginiz için çok teşekkür ederim....
Son düzenleme:
- Katılım
- 13 Ekim 2004
- Mesajlar
- 16,058
- Excel Vers. ve Dili
-
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki şekilde deneyin.
Kod:
Sub YirmiAltı_SATIR_EKLE()
For x = [A65536].End(3).Row To 3 Step -1
If Cells(x, 1) <> Cells(x - 1, 1) Then
Rows(x & ":" & x + 26).Insert shift:=xlDown
Range("a" & x & ":a" & x + 26) = Cells(x - 1, 1)
Range("b" & x & ":aa" & x + 26) = Range("b" & x - 1 & ":aa" & x - 1).Formula
End If
Next
End SubÇok teşekkür ederim Sayın leventm;
Dediğiniz şekilde yapmaya çalıştım. Eklenen satır sayısı 27 oldu ama ordaki 26 sayılarını 25 yaparak, değiştirerek toplamda 27 satır olması için gerekli 26 eklemeyi ve isimleri ekletmeyi gerçekleştirebildim.
Ancak, sadece A sütunundaki isimlerin tekrarını yaptırırken B2:Z28 arasında bulunan ve her satırda farklı olan (hücrelerde değil) formülleri sizin formülünüzle eklemiş olduğumuz yeni satırlara yapıştırmak istiyorum.
Daha otomasyon şekliyle yapacak olursak;
1. Belirleyeceğimiz sayıda(örn.3) satır ekletmek, 2. ilk sütündaki değerlerin eklenecak sayıda tekrarının sağlanması, 3. belirlenen hücre aralığındaki (tek bir satır için: B2 ile Z2; 3 satır için de B2 ile Z4 arasında satırlardaki formül) formülün belirlediğimiz sayıda(örn 3)eklenen satırın B sütunundan Z sütunana aynı formülleri yapıştırmak. Son kısımdaki ızdırabımı
tam olarak anlatabildimmi bilemiyorum ama;
...A......................................B..................................................................................C
2 Ahmet .....formül(örneğin):=DÜŞEYARA($A2;tablo$A$3:$HW$280;b$1;YANLIŞ....=DÜŞEYARA($A2;tablo$A$3:$HW$280;c$1;YANLIŞ
3 Ahmet......formül(örneğin) =DÜŞEYARA($A3;tablo$A$400:$HW$680;b$1;YANLIŞ...=DÜŞEYARA($A3;tablo$A$400:$HW$680;c$1;YANLIŞ
4 Ahmet........
..
27 Ahmet
28 Hasan
29 Hasan
30 Hasan
..
Bu durumda Hasan isminin geçmiş olduğu ilk satırda(ki bu 27.satır örnekte) 2. satırdaki B hücresinden Z hücresine kadar uygulanan formülü
Hasan isminin 2.tekrarlamasında 3 satırda bulunan B-Z arasındaki formül...vs vs..
Hasan isminin 3.tekrarlamasında 4 satırda bulunan B-Z arasındaki formül
Umarım sizleriniz vaktinizi almadan anlatabilmişimdir.
Göstermiş olduğunuz özveriniz ve ilginiz için şimdiden çok teşekkür ederim.
Dediğiniz şekilde yapmaya çalıştım. Eklenen satır sayısı 27 oldu ama ordaki 26 sayılarını 25 yaparak, değiştirerek toplamda 27 satır olması için gerekli 26 eklemeyi ve isimleri ekletmeyi gerçekleştirebildim.
Ancak, sadece A sütunundaki isimlerin tekrarını yaptırırken B2:Z28 arasında bulunan ve her satırda farklı olan (hücrelerde değil) formülleri sizin formülünüzle eklemiş olduğumuz yeni satırlara yapıştırmak istiyorum.
Daha otomasyon şekliyle yapacak olursak;
1. Belirleyeceğimiz sayıda(örn.3) satır ekletmek, 2. ilk sütündaki değerlerin eklenecak sayıda tekrarının sağlanması, 3. belirlenen hücre aralığındaki (tek bir satır için: B2 ile Z2; 3 satır için de B2 ile Z4 arasında satırlardaki formül) formülün belirlediğimiz sayıda(örn 3)eklenen satırın B sütunundan Z sütunana aynı formülleri yapıştırmak. Son kısımdaki ızdırabımı
tam olarak anlatabildimmi bilemiyorum ama; ...A......................................B..................................................................................C
2 Ahmet .....formül(örneğin):=DÜŞEYARA($A2;tablo$A$3:$HW$280;b$1;YANLIŞ
....=DÜŞEYARA($A2;tablo$A$3:$HW$280;c$1;YANLIද Ahmet......formül(örneğin) =DÜŞEYARA($A3;tablo$A$400:$HW$680;b$1;YANLIŞ
...=DÜŞEYARA($A3;tablo$A$400:$HW$680;c$1;YANLIධ Ahmet........
..
27 Ahmet
28 Hasan
29 Hasan
30 Hasan
..
Bu durumda Hasan isminin geçmiş olduğu ilk satırda(ki bu 27.satır örnekte) 2. satırdaki B hücresinden Z hücresine kadar uygulanan formülü
Hasan isminin 2.tekrarlamasında 3 satırda bulunan B-Z arasındaki formül...vs vs..
Hasan isminin 3.tekrarlamasında 4 satırda bulunan B-Z arasındaki formül
Umarım sizleriniz vaktinizi almadan anlatabilmişimdir.
Göstermiş olduğunuz özveriniz ve ilginiz için şimdiden çok teşekkür ederim.
Son düzenleme:
- Katılım
- 13 Ekim 2004
- Mesajlar
- 16,058
- Excel Vers. ve Dili
-
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Dosyanızı eklerseniz daha hızlı çözüm bulunabileceğini düşünüyorum.
- Katılım
- 15 Mart 2005
- Mesajlar
- 42,738
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Selamlar,
Biraz geç oldu ama ekteki örnek dosyayı incelermisiniz. Umarım faydası olur.
Uygulanan kod;
Biraz geç oldu ama ekteki örnek dosyayı incelermisiniz. Umarım faydası olur.
Uygulanan kod;
Kod:
Sub YEDİ_SATIR_EKLE_TOPLAM_AL()
BAŞLIK = [A1:J1]
For X = [A65536].End(3).Row To 3 Step -1
If Cells(X, 1) <> Cells(X - 1, 1) Then
Rows(X & ":" & X + 7).Insert shift:=xlDown
Range(Cells(X + 7, "A"), Cells(X + 7, "J")) = BAŞLIK
End If
Next
For Each ALAN In Columns("I").SpecialCells(xlConstants, xlNumbers).Areas
ADRES1 = ALAN.Offset(0, 1).Address(False, False)
ADRES2 = Replace(Mid(ALAN.Offset(7, 1).Address(False, False), 1, 3), ":", "")
ADRES3 = ALAN.Offset(8, 1).Resize(3, 1).Address(False, False)
ADRES4 = Replace(Mid(ALAN.Offset(11, 1).Address(False, False), 1, 3), ":", "")
ALAN.Offset(ALAN.Count + 1, -8).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -8).Resize(1, 1)
ALAN.Offset(ALAN.Count + 2, -8).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -8).Resize(1, 1)
ALAN.Offset(ALAN.Count + 3, -8).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -8).Resize(1, 1)
ALAN.Offset(ALAN.Count + 1, -7).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -7).Resize(1, 1)
ALAN.Offset(ALAN.Count + 2, -7).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -7).Resize(1, 1)
ALAN.Offset(ALAN.Count + 3, -7).Resize(1, 1).Formula = ALAN.Offset(ALAN.Count - 2, -7).Resize(1, 1)
ALAN.Offset(ALAN.Count, -2).Resize(1, 1).Formula = 1
ALAN.Offset(ALAN.Count, -1).Resize(1, 1).Formula = "Hammadde Mlz. Toplamı"
ALAN.Offset(ALAN.Count, 1).Resize(1, 1).Formula = "=SUM(" & ADRES1 & ")"
ALAN.Offset(ALAN.Count + 1, -2).Resize(1, 1).Formula = 2
ALAN.Offset(ALAN.Count + 1, -1).Resize(1, 1).Formula = "Direkt İşçilik"
ALAN.Offset(ALAN.Count + 2, -2).Resize(1, 1).Formula = 3
ALAN.Offset(ALAN.Count + 2, -1).Resize(1, 1).Formula = "Gim"
ALAN.Offset(ALAN.Count + 3, -2).Resize(1, 1).Formula = 4
ALAN.Offset(ALAN.Count + 3, -1).Resize(1, 1).Formula = "Amortisman"
ALAN.Offset(ALAN.Count + 4, -2).Resize(1, 1).Formula = 5
ALAN.Offset(ALAN.Count + 4, -1).Resize(1, 1).Formula = "Masraf Toplamı"
ALAN.Offset(ALAN.Count + 4, 1).Resize(1, 1).Formula = "=SUM(" & ADRES3 & ")"
ALAN.Offset(ALAN.Count + 5, -2).Resize(1, 1).Formula = 6
ALAN.Offset(ALAN.Count + 5, -1).Resize(1, 1).Formula = "Üretim Maliyeti"
ALAN.Offset(ALAN.Count + 5, 1).Resize(1, 1).Formula = "=SUM(" & ADRES2 & "," & ADRES4 & ")"
Next
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub