+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Şartlı Veri Aktarmak (/konu-sartli-veri-aktarmak.html)
Şartlı Veri Aktarmak - m_demir - 02/02/2021
Merhaba Arkadaşlar
Eklediğim uygulamada L1 Hücresine yazdığım rakama göre aktarma yapsın.
Örneğin L1 1 yazdığım zaman
Ocak Ayına aktarma yapsın
A2 deki veriyi Ocak ayına Q4 e aktarsın
B2 deki veriyi Ocak ayına R4 e aktarsın
D2 deki veriyi Ocak ayına S4 e aktarsın
F2 deki veriyi Ocak ayına U4 e aktarsın
G2 deki veriyi Ocak ayına V4 e aktarsın
H2 deki veriyi Ocak ayına W4 e aktarsın
L1 E 2 yazdığımız zaman şubat ayına aktarsın
RE: Şartlı Veri Aktarmak - userx - 02/02/2021
Sayın m_demir
Aktar butonuna aşağıdaki kodu yazarak dener misiniz?
With ThisWorkbook.Sheets("Sayfa1")
Dim i As Long
i = .Range("L1") + 3
.Range("Q" & i & ":" & "R" & i).Value = .Range("A2:C2").Value
.Range("U" & i & ":" & "V" & i).Value = .Range("F2:G2").Value
.Range("S" & i).Value = .Range("Q" & i).Value - Range("R" & i).Value
.Range("W" & i).Value = .Range("U" & i).Value - Range("V" & i).Value
End With
MsgBox "İşlem Tamamlandı"
RE: Şartlı Veri Aktarmak - m_demir - 02/02/2021
Çok teşekkürler Hocam ellerinize sağlık tam istediğim gibi olmuş.
*Hocam L1 hücresi boş olduğu zaman uyarı verse çok iyi olur.
*Aktarılacak Hücreler dolu ise Daha önce aktarma yarılmış, verileri değiştirmek istiyormusunuz evet hayıt onayı istesin.
Re: Şartlı Veri Aktarmak - userx - 02/02/2021
Sub Aktar()
If Range("L1") = "" Or Range("L1") > 12 Then
MsgBox "L1 Alanına geçerli bir değer girmediniz."
Else
With ThisWorkbook.Sheets("Sayfa1")
Dim i As Long
i = .Range("L1") + 3
If Range("Q" & i).Value = "" Then
.Range("Q" & i & ":" & "R" & i).Value = .Range("A2:C2").Value
.Range("U" & i & ":" & "V" & i).Value = .Range("F2:G2").Value
.Range("S" & i).Value = .Range("Q" & i).Value - Range("R" & i).Value
.Range("W" & i).Value = .Range("U" & i).Value - Range("V" & i).Value
Else
If MsgBox("Kaydetmek istediğiniz alanda kayıt var. Değişiklik yapılsın mı?", vbCritical + vbYesNo + vbDefaultButton1, "UYARI") = vbNo Then Exit Sub
.Range("Q" & i & ":" & "R" & i).Value = .Range("A2:C2").Value
.Range("U" & i & ":" & "V" & i).Value = .Range("F2:G2").Value
.Range("S" & i).Value = .Range("Q" & i).Value - Range("R" & i).Value
.Range("W" & i).Value = .Range("U" & i).Value - Range("V" & i).Value
End If
End With
MsgBox "İşlem Tamamlandı"
End If
End Sub
Üstteki kodu dener misin?
RE: Şartlı Veri Aktarmak - m_demir - 02/02/2021
Çok, çok teşekkürler Hocam ellerinize sağlık. Tam istediğim gibi olmuş.
Hocam konuyu taşıtabilirsiniz saygılarımla sağlıklı günler diliyorum.