Soru Veri Aktar

Katılım
7 Şubat 2021
Mesajlar
531
Excel Vers. ve Dili
2010, Türkiye
Merhabalar;
Ekli dosyada veri girişi sayfasında ki bazı hücrelerdeki verileri makro ile toplam beyan sayfasına aktarmak istiyorum.
1-Yeni kayıt yapılırken G6 hücresinde yazan örneğin 1 Nolu Tespiti Kayıt Yaptırmak İstiyormusunuz .Evet/Hayır seçeneği olacak. Evet Seçilirse Yeni Kayıt Yapıldı. Hayır Seçilirse Kayıt Yapılmadı uyarısı verecek
2-Eğer kayıt daha önceden yapılmış ise g6 hücresinde yazan örneğin 1 Nolu Tespit Daha önceden Kayıt Yapılmış .Değiştirmek İstiyor musunuz .Evet seçilirse Kayıt Değiştirildi. Hayır seçilirse değişiklik yapılmadı şeklinde uyarı verilebilir mi. Yardımcı olursanız sevinirim

Veri Girişi Sayfasındaki G6 Hücresindeki veriyi Toplam Beyan Sayfasında C Sutununa
Veri Girişi Sayfasındaki G10 Hücresindeki veriyi Toplam Beyan Sayfasında D Sutununa
Veri Girişi Sayfasındaki J21 Hücresindeki veriyi Toplam Beyan Sayfasında E Sutununa
Veri Girişi Sayfasındaki K21 Hücresindeki veriyi Toplam Beyan Sayfasında F Sutununa

 

catalinastrap

Özgür
Destek Ekibi
Katılım
19 Ağustos 2006
Mesajlar
628
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO /64 bit /Türkçe
Bir buton ekleyip kodu atayabilirsiniz.


Sub KayitKontrolVeAktarim()
Dim cevap As Integer
Dim wsVeri As Worksheet, wsBeyan As Worksheet
Dim sonSatir As Long
Dim mevcutKayit As Boolean

Set wsVeri = ThisWorkbook.Sheets("Veri Girişi")
Set wsBeyan = ThisWorkbook.Sheets("Toplam Beyan")


sonSatir = wsBeyan.Cells(wsBeyan.Rows.Count, "C").End(xlUp).Row
mevcutKayit = False

Dim i As Long
For i = 2 To sonSatir
If wsBeyan.Cells(i, "C").Value = wsVeri.Range("G6").Value Then
mevcutKayit = True
Exit For
End If
Next i

If Not mevcutKayit Then
cevap = MsgBox(wsVeri.Range("G6").Value & " Kayıt yaptırmak istiyor musunuz?", vbYesNo + vbQuestion, "Yeni Kayıt")
If cevap = vbYes Then

sonSatir = sonSatir + 1
wsBeyan.Cells(sonSatir, "C").Value = wsVeri.Range("G6").Value
wsBeyan.Cells(sonSatir, "D").Value = wsVeri.Range("G10").Value
wsBeyan.Cells(sonSatir, "E").Value = wsVeri.Range("J21").Value
wsBeyan.Cells(sonSatir, "F").Value = wsVeri.Range("K21").Value
MsgBox "Yeni kayıt yapıldı.", vbInformation
Else
MsgBox "Kayıt yapılmadı.", vbExclamation
End If
Else
cevap = MsgBox(wsVeri.Range("G6").Value & " daha önceden kayıt yapılmış. Değiştirmek istiyor musunuz?", vbYesNo + vbQuestion, "Kayıt Güncelle")
If cevap = vbYes Then

wsBeyan.Cells(i, "D").Value = wsVeri.Range("G10").Value
wsBeyan.Cells(i, "E").Value = wsVeri.Range("J21").Value
wsBeyan.Cells(i, "F").Value = wsVeri.Range("K21").Value
MsgBox "Kayıt değiştirildi.", vbInformation
Else
MsgBox "Değişiklik yapılmadı.", vbExclamation
End If
End If

End Sub
 
Katılım
7 Şubat 2021
Mesajlar
531
Excel Vers. ve Dili
2010, Türkiye
Özgür bey çok teşekkür ederim. Emeğinize sağlık. Toplam Beyan sayfasında E ve F sütununda veri varsa değişiklik olmayacak. Veri yoksa boş olan hücrelere yazılacak. Yeni fark ettim. Makro bu şekilde revize etmeniz mümkün mü acaba
 

catalinastrap

Özgür
Destek Ekibi
Katılım
19 Ağustos 2006
Mesajlar
628
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO /64 bit /Türkçe
Böyle Bir deneyin bakalım

Sub KayitKontrolVeAktarim()
Dim cevap As Integer
Dim wsVeri As Worksheet, wsBeyan As Worksheet
Dim sonSatir As Long
Dim mevcutKayit As Boolean

Set wsVeri = ThisWorkbook.Sheets("Veri Girişi")
Set wsBeyan = ThisWorkbook.Sheets("Toplam Beyan")

sonSatir = wsBeyan.Cells(wsBeyan.Rows.Count, "C").End(xlUp).Row
mevcutKayit = False

Dim i As Long
For i = 2 To sonSatir
If wsBeyan.Cells(i, "C").Value = wsVeri.Range("G6").Value Then
mevcutKayit = True
Exit For
End If
Next i

If Not mevcutKayit Then
cevap = MsgBox(wsVeri.Range("G6").Value & " Kayıt yaptırmak istiyor musunuz?", vbYesNo + vbQuestion, "Yeni Kayıt")
If cevap = vbYes Then
sonSatir = sonSatir + 1
wsBeyan.Cells(sonSatir, "C").Value = wsVeri.Range("G6").Value
wsBeyan.Cells(sonSatir, "D").Value = wsVeri.Range("G10").Value
wsBeyan.Cells(sonSatir, "E").Value = wsVeri.Range("J21").Value
wsBeyan.Cells(sonSatir, "F").Value = wsVeri.Range("K21").Value
MsgBox "Yeni kayıt yapıldı.", vbInformation
Else
MsgBox "Kayıt yapılmadı.", vbExclamation
End If
Else
' E ve F sütununda veri var mı kontrolü eklendi
Dim eDolu As Boolean, fDolu As Boolean
eDolu = (Not IsEmpty(wsBeyan.Cells(i, "E").Value))
fDolu = (Not IsEmpty(wsBeyan.Cells(i, "F").Value))

If eDolu Or fDolu Then
MsgBox "Bu kaydın E veya F sütununda veri mevcut, değişiklik yapılamaz.", vbExclamation
Else
cevap = MsgBox(wsVeri.Range("G6").Value & " daha önceden kayıt yapılmış. Değiştirmek istiyor musunuz?", vbYesNo + vbQuestion, "Kayıt Güncelle")
If cevap = vbYes Then
wsBeyan.Cells(i, "D").Value = wsVeri.Range("G10").Value
If Not eDolu Then wsBeyan.Cells(i, "E").Value = wsVeri.Range("J21").Value
If Not fDolu Then wsBeyan.Cells(i, "F").Value = wsVeri.Range("K21").Value
MsgBox "Kayıt değiştirildi (sadece boş olan hücreler güncellendi).", vbInformation
Else
MsgBox "Değişiklik yapılmadı.", vbExclamation
End If
End If
End If
End Sub
 
Katılım
7 Şubat 2021
Mesajlar
531
Excel Vers. ve Dili
2010, Türkiye
Hocam birinde veri var birinde yoksa veri olan yeri değiştirmeyecek. Veri olmayan yere yazacak. Birinde veri olmadığı halde aktarım yapmıyor
 

catalinastrap

Özgür
Destek Ekibi
Katılım
19 Ağustos 2006
Mesajlar
628
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO /64 bit /Türkçe
böyle denermisiniz bide

Sub KayitKontrolVeAktarim()
Dim cevap As Integer
Dim wsVeri As Worksheet, wsBeyan As Worksheet
Dim sonSatir As Long
Dim mevcutKayit As Boolean

Set wsVeri = ThisWorkbook.Sheets("Veri Girişi")
Set wsBeyan = ThisWorkbook.Sheets("Toplam Beyan")

sonSatir = wsBeyan.Cells(wsBeyan.Rows.Count, "C").End(xlUp).Row
mevcutKayit = False

Dim i As Long
For i = 2 To sonSatir
If wsBeyan.Cells(i, "C").Value = wsVeri.Range("G6").Value Then
mevcutKayit = True
Exit For
End If
Next i

If Not mevcutKayit Then
cevap = MsgBox(wsVeri.Range("G6").Value & " Kayıt yaptırmak istiyor musunuz?", vbYesNo + vbQuestion, "Yeni Kayıt")
If cevap = vbYes Then
sonSatir = sonSatir + 1
wsBeyan.Cells(sonSatir, "C").Value = wsVeri.Range("G6").Value
wsBeyan.Cells(sonSatir, "D").Value = wsVeri.Range("G10").Value
wsBeyan.Cells(sonSatir, "E").Value = wsVeri.Range("J21").Value
wsBeyan.Cells(sonSatir, "F").Value = wsVeri.Range("K21").Value
MsgBox "Yeni kayıt yapıldı.", vbInformation
Else
MsgBox "Kayıt yapılmadı.", vbExclamation
End If
Else
Dim eDolu As Boolean, fDolu As Boolean
eDolu = (Not IsEmpty(wsBeyan.Cells(i, "E").Value))
fDolu = (Not IsEmpty(wsBeyan.Cells(i, "F").Value))

If eDolu Or fDolu Then
MsgBox "Bu kaydın E veya F sütununda veri mevcut, değişiklik yapılamaz.", vbExclamation
Else
cevap = MsgBox(wsVeri.Range("G6").Value & " daha önceden kayıt yapılmış. Değiştirmek istiyor musunuz?", vbYesNo + vbQuestion, "Kayıt Güncelle")
If cevap = vbYes Then
wsBeyan.Cells(i, "D").Value = wsVeri.Range("G10").Value
wsBeyan.Cells(i, "E").Value = wsVeri.Range("J21").Value
wsBeyan.Cells(i, "F").Value = wsVeri.Range("K21").Value
MsgBox "Kayıt değiştirildi.", vbInformation
Else
MsgBox "Değişiklik yapılmadı.", vbExclamation
End If
End If
End If
End Sub
 
Katılım
7 Şubat 2021
Mesajlar
531
Excel Vers. ve Dili
2010, Türkiye
Hocam değişiklik olmadı .Birinde veri varken var olanı değiştirmeyecek. Olmayana yazması gerekiyor
 

catalinastrap

Özgür
Destek Ekibi
Katılım
19 Ağustos 2006
Mesajlar
628
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO /64 bit /Türkçe
Hocam birinde veri var birinde yoksa veri olan yeri değiştirmeyecek. Veri olmayan yere yazacak. Birinde veri olmadığı halde aktarım yapmıyor

TOPLAM BEYAN sayfasına zaten VERİ GİRİŞİ sayfasından data aktarıyoruz ve bir kayıt aktarıldıysa aynısı olmasın dediniz. Dolayısı ile her aktarılan kayıt yeni kayıt olarak algılanır dolayısı ile aktarılan yeni kayıt için TOPLAM BEYAN sayfasındaki aktarılacak satır zaten boş olan satır olur neresi dolu yada değil kontrolü istediğinizi tam olarak anlamadım.Net açıklarsanız ona odaklanalım
 
Katılım
7 Şubat 2021
Mesajlar
531
Excel Vers. ve Dili
2010, Türkiye
Hocam veri girişi sayfasında örneğin 1.Nolu Ölçü Tespiti aktardık. Aktardığımız veri Toplam beyan sayfasında m³ olan E sütunu, ster olan ise F sütunu. Eğer ben yeni kayıtta veri girişi sayfasından m³ ve steri aktarmak istediğimde (J21 ve K21 hücresi) toplam beyan sayfasında hiç veri olmadığı için aktarma yapacak. Diyelim her ikisini aktarım yaptım. 1.Nolu Ölçü Tespiti Tekrar aktarmak istediğimde Toplam beyan sayfasında her iki sütun dolu olduğu için aktarım olmayacak. Eğer ben ilk başta sadece M3 veya sadece steri aktarım yapıp ; aktarılan sayfada örneğin ster alanı boş , m3 dolu aktarma sadece ster sütununa olacak. Diğer dolu olan m3 kısmında değişiklik olmayacak
 

catalinastrap

Özgür
Destek Ekibi
Katılım
19 Ağustos 2006
Mesajlar
628
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO /64 bit /Türkçe
Bahsettiğiniz aynı tespit tutanağını tekrar aktarmak istersem eski kaydı güncellesin boş / dolu kontrolü yapsın doğru anlıyorum değilmi
 

catalinastrap

Özgür
Destek Ekibi
Katılım
19 Ağustos 2006
Mesajlar
628
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO /64 bit /Türkçe
bu halini bir denermisin

Sub KaydiKontrolEtVeAktar()
Dim wsVeri As Worksheet
Dim wsBeyan As Worksheet
Dim tespitNo As String
Dim g10 As Variant, j21 As Variant, k21 As Variant
Dim sonSatir As Long
Dim varMi As Boolean
Dim i As Long
Dim cevap As VbMsgBoxResult

Set wsVeri = ThisWorkbook.Sheets("Veri Girişi")
Set wsBeyan = ThisWorkbook.Sheets("Toplam Beyan")

tespitNo = wsVeri.Range("G6").Value
g10 = wsVeri.Range("G10").Value
j21 = wsVeri.Range("J21").Value
k21 = wsVeri.Range("K21").Value

varMi = False
sonSatir = wsBeyan.Cells(wsBeyan.Rows.Count, "C").End(xlUp).Row


For i = 2 To sonSatir
If wsBeyan.Cells(i, "C").Value = tespitNo Then
varMi = True
Exit For
End If
Next i

If varMi Then
cevap = MsgBox("Aynı kayıt (" & tespitNo & ") zaten mevcut. Yine de kaydetmek istiyor musunuz?", vbYesNo + vbQuestion, "Kayıt Mevcut")
If cevap = vbYes Then

wsBeyan.Cells(i, "D").Value = g10

If IsEmpty(wsBeyan.Cells(i, "E").Value) Or wsBeyan.Cells(i, "E").Value = "" Then
wsBeyan.Cells(i, "E").Value = j21
End If

If IsEmpty(wsBeyan.Cells(i, "F").Value) Or wsBeyan.Cells(i, "F").Value = "" Then
wsBeyan.Cells(i, "F").Value = k21
End If
MsgBox "Kayıt başarıyla güncellendi.", vbInformation
Else
MsgBox "İşlem iptal edildi.", vbExclamation
End If
Else

wsBeyan.Cells(sonSatir + 1, "C").Value = tespitNo
wsBeyan.Cells(sonSatir + 1, "D").Value = g10
wsBeyan.Cells(sonSatir + 1, "E").Value = j21
wsBeyan.Cells(sonSatir + 1, "F").Value = k21
MsgBox "Kayıt başarıyla aktarıldı.", vbInformation
End If
End Sub
 
Katılım
7 Şubat 2021
Mesajlar
531
Excel Vers. ve Dili
2010, Türkiye
Hocam veri girişi sayfasında ster kısmını boş bırakıp m3 dolu şekilde gönderdiğim zaman toplam kısmında ster kısmına "0" yazıyor. 2.kez veri sayfasında ster kısmını yazıp aktar dediğimde toplam sayfasında ster sutunun da "0" veri gördüğü için steri aktarmıyor. Toplam sayfasında aktarıldıktan sonra ilgili sütunlarda M3 ve ster için "0" yazmasa tamam olacak
 

catalinastrap

Özgür
Destek Ekibi
Katılım
19 Ağustos 2006
Mesajlar
628
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO /64 bit /Türkçe
Merhaba kod bir yere sıfır yazmıyor sanırım sizin VERİ GİRİŞİ sayfasında bu data var onu da ayıklıyorum

Sub KaydiKontrolEtVeAktar()
Dim wsVeri As Worksheet
Dim wsBeyan As Worksheet
Dim tespitNo As String
Dim g10 As Variant, j21 As Variant, k21 As Variant
Dim sonSatir As Long
Dim varMi As Boolean
Dim i As Long
Dim cevap As VbMsgBoxResult

Set wsVeri = ThisWorkbook.Sheets("Veri Girişi")
Set wsBeyan = ThisWorkbook.Sheets("Toplam Beyan")

tespitNo = wsVeri.Range("G6").Value
g10 = wsVeri.Range("G10").Value
j21 = wsVeri.Range("J21").Value
k21 = wsVeri.Range("K21").Value

varMi = False
sonSatir = wsBeyan.Cells(wsBeyan.Rows.Count, "C").End(xlUp).Row


For i = 2 To sonSatir
If wsBeyan.Cells(i, "C").Value = tespitNo Then
varMi = True
Exit For
End If
Next i

If varMi Then
cevap = MsgBox("Aynı kayıt (" & tespitNo & ") zaten mevcut. Yine de kaydetmek istiyor musunuz?", vbYesNo + vbQuestion, "Kayıt Mevcut")
If cevap = vbYes Then

If g10 <> 0 And g10 <> "0" And g10 <> "" Then
wsBeyan.Cells(i, "D").Value = g10
End If

If (IsEmpty(wsBeyan.Cells(i, "E").Value) Or wsBeyan.Cells(i, "E").Value = "") And j21 <> 0 And j21 <> "0" And j21 <> "" Then
wsBeyan.Cells(i, "E").Value = j21
End If

If (IsEmpty(wsBeyan.Cells(i, "F").Value) Or wsBeyan.Cells(i, "F").Value = "") And k21 <> 0 And k21 <> "0" And k21 <> "" Then
wsBeyan.Cells(i, "F").Value = k21
End If
MsgBox "Kayıt başarıyla güncellendi.", vbInformation
Else
MsgBox "İşlem iptal edildi.", vbExclamation
End If
Else

Dim yeniSatir As Long
yeniSatir = sonSatir + 1
wsBeyan.Cells(yeniSatir, "C").Value = tespitNo

If g10 <> 0 And g10 <> "0" And g10 <> "" Then
wsBeyan.Cells(yeniSatir, "D").Value = g10
End If
If j21 <> 0 And j21 <> "0" And j21 <> "" Then
wsBeyan.Cells(yeniSatir, "E").Value = j21
End If
If k21 <> 0 And k21 <> "0" And k21 <> "" Then
wsBeyan.Cells(yeniSatir, "F").Value = k21
End If
MsgBox "Kayıt başarıyla aktarıldı.", vbInformation
End If
End Sub
 
Katılım
7 Şubat 2021
Mesajlar
531
Excel Vers. ve Dili
2010, Türkiye
Özgür bey çok teşekkür ediyorum.Ellerinize sağlık
 
Üst