AccessTr.neTMicrosoft ExcelExcel Cevaplanmış Soruları

Excelde İki Satır Arasına Vba İle Kayıt Ekleme

1 2 3 4
25/11/2023, 14:57

hnakis

Sayın site üyeleri ve ustalar. ekteki çalışmada sabit satır arasına yeni veri ekleme ile ilgili bir yardıma ihtiyacım var.

çalışmada deneme adlı çalışma sayfasında B4 hücresinde listeden bir kayıt seçildiğinde F3:Y3 arasındaki gizli sütunlara listeden seçilen kayda ait özellikler görünür hale geçiyor. Kg yazan sütunda seçilen kayda sayı değeri girildiğinde hesaplama yapıyor. yapmak istediğim alt bölümde bulunan garanti edilen içerik kısmına B23:B24 satırlarının arasından başlayarak F3:Y3 arasında görünen özelliklerin ve F20:Y20 arasında hesaplanmış değerlerle beraber eklenmesini (D23;D24 arasına eklenecek)yapmaya çalışıyorum. eğer F20:Y20 sıfır değere sahipse Özellik adı ve değer eklenmeyecek. Ekleme işlemi yeni satır eklenerek olmalı. çalışmanın içinde araya ekleme kodu var ancak ana sayfaya bunu entegre edemedim.


Saygılar. iyi çalışmalar.
25/11/2023, 18:00

feraz

Konuyu anlamadım ama öncede yapmak istediğim ama unuttuğum kod hızlandırmasını yaptım.
igili kodu alttaki ile değiştirip deneyin.
Ayrıca bazı cells yazan yerlere aktif sayfanın ismini yazmalısınız eğer başka safadayken kod çalışırsa o aktif sayfada işlem yapar hata olur ama değilse gerek yok ben kod sayfa kodlarına eklemiştim bundan dolayı eklememiştim siz modül içine almışsınız.

Kod:
Sub Aktar()
    Dim bul, bul2, ara As Range, say As Integer, i As Integer
    
    say = 1: ReDim arr(1 To 1)
    With ThisWorkbook.Worksheets("Kimya")
        For i = 4 To 18
            bul = Application.Match(Cells(i, "B").Value2, .Range("C:C"), 0)
            If Not IsError(bul) Then
                'içerik eklenirse burdan tekrar düzenle
                For Each ara In .Range("I" & bul & ":BU" & bul)
                    ReDim Preserve arr(1 To say)
                    If Len(Trim(ara.Value)) > 0 Then
                        If Trim(Cells(3, say + 1).Value) = "" Then
                            bul2 = Application.Match(.Cells(2, ara.Column).Value2, arr, 0)
                            If Not IsError(bul2) Then
                                arr(say) = arr(bul2)
                            Else
                                arr(say) = .Cells(2, ara.Column).Value
                                say = say + 1
                            End If
                        End If
                    End If
                Next
            End If
        Next
       If say > 1 Then Cells(3, "G").Resize(1, say).Value = arr
    End With
End Sub
25/11/2023, 18:21

hnakis

sayın feraz kod için teşekkür ederim.
F3:Y3 sütunlarında görünür olduğunda yazan metinlerin B23:B24 arasına yeni satır eklenerek sırayla ve F20:Y20 arasındaki hesaplanmış rakamların (Eğer sıfır değeri değilse) D23 anlaşılmayan yeri söylerseniz tekrar anlatabilirim.




25/11/2023, 19:00

feraz

Rica ederim,resime bakaraktsn anladım.Müsait olunca yapıp eklerim.
26/11/2023, 00:46

hnakis

sayın feraz teşekkürler kod güzel çalışıyor. bir tek sorun var sadece.

F3 hücresinde;
=EĞER( "Üre Azotu (N-NH2)";"Amonyum Azotu (N-NH3)";"Nitrat Azotu (N-NO3)";"Organik-N")
varsa "Toplam Azot" yazar yoksa boş kalır.

seçilen maddelerde bunlardan biri olmadığında F3 boş kaldığı için verdiğiniz kod başka şeyleri ekliyor.

çalışmada görmek isterseniz hiç seçili isim yokken Çinko oksit seçin ve kg sayı değeri yazın ne demek istediğimi göreceksiniz.
bu sorunu nasıl çözebiliriz.

birde listeden seçim yaptıktan sonra sayı değeri giriyoruz hesaplama yapılıyor ama yeni bir kayıt seçmeden garanti edilen içerik bölümüne bir önceki seçimin hesaplanmış değerini eklemiyor.

Saygılar. iyi çalışmalar.




26/11/2023, 02:13

feraz

Son hali.
Son hali.
1 2 3 4