Araya Veri Girişi

[igultekin2000]

iyi günler;
Kullanmakta olduğum makroda güncelleme yapmak istiyorum.
B hücresi boş ise C hücresi B hücresine
D hücresi boş ise E hücresi D hücresine
aktarılması şeklinde güncellemek istiyorum. Teşekkürler.

Sub test()
son = Cells(Rows.Count, 1).End(3).Row
a = Range("B3:E" & son).Value
ReDim b(1 To UBound(a), 1 To 2)
For i = 1 To UBound(a)
    If a(i, 3) = "" Then
        b(i, 1) = a(i, 1)
    Else
        b(i, 1) = a(i, 3)
    End If
    If a(i, 4) = "" Then
        b(i, 2) = a(i, 2)
    Else
        b(i, 2) = a(i, 4)
    End If
Next i
[B3].Resize(UBound(a), 2) = b
MsgBox "İşlem tamam.", vbInformation
End Sub

 

[Muzaffer Ali]

Merhaba.

Buyurun.

Sub Test()
    Dim Say As Long
    Dim Bak As Long
    Say = Cells(Rows.Count, "A").End(3).Row
    For Bak = 1 To Say
        If Cells(Bak, "B") = "" Then
            Cells(Bak, "B") = Cells(Bak, "C")
        ElseIf Cells(Bak, "D-") = "" Then
            Cells(Bak, "D") = Cells(Bak, "E")
        End If
    Next
    MsgBox "İşlem tamam.", vbInformation
End Sub

 

[igultekin2000]

Merhaba.

Buyurun.

Sub Test()
    Dim Say As Long
    Dim Bak As Long
    Say = Cells(Rows.Count, "A").End(3).Row
    For Bak = 1 To Say
        If Cells(Bak, "B") = "" Then
            Cells(Bak, "B") = Cells(Bak, "C")
        ElseIf Cells(Bak, "D-") = "" Then
            Cells(Bak, "D") = Cells(Bak, "E")
        End If
    Next
    MsgBox "İşlem tamam.", vbInformation
End Sub

örnek hata veriyor.

 

[Orion1]

İlgili satırı aşağıdaki ile değiştirin.

 ElseIf Cells(Bak, "D") = "" Then

 

[Muzaffer Ali]

Birinci mesajda dediniz ki;

iyi günler;
Kullanmakta olduğum makroda güncelleme yapmak istiyorum.
B hücresi boş ise C hücresi B hücresine
D hücresi boş ise E hücresi D hücresine
aktarılması şeklinde güncellemek istiyorum. Teşekkürler.

Şimdi de dosya içerisinde yazdığınız mesajda diyorsunuz ki;

D Sütünündaki değerler B sütununa E Sütunudaki değerler C sütununa kopyalanacak yerde değer varsa yok sayılıp üzerine kopyanması şeklinde.

Şimdi hangisini yapalım? İki mesajınız da belirttiğiniz şartlar birbirinden tamamen farklı.

1. B hücresinin boş olup olmamasına bakılacak mı, bakılmayacak mı?
2. B hücresine C mi D mi kopyalanacak?

Lütfen sorunuzu en başından itibaren tutarlı bir şekilde sorunuz.

 

[igultekin2000]

Birinci mesajda dediniz ki;

Kusura bakmayın sorumu düzeltiyorum.
B sütundaki hücre boş ise C sütunundaki hücre B sütununa taşınarak silinmesi ayın şekilde D sütunundaki hücre boş ise E sütunundaki hücre D sütununa taşınması, C ve E deki değerlerin taşınarak, yani aktarıldıktan sonra silinmesi
iyi çalışmalar

 

[igultekin2000]

İlgili satırı aşağıdaki ile değiştirin.

 ElseIf Cells(Bak, "D") = "" Then

bu şekilde makro hata vermedi, ancak aktarılan sütunların silinmesi de gerekiyor.
teşekkürler

 

[Orion1]

D sütununda boş gibi görülen hücrelerde boşluk var.Onları düzeltiniz.
Buyurun.

Sub Test()
    Dim Say As Long
    Dim Bak As Long
    Say = Cells(Rows.Count, "A").End(3).Row
    For Bak = 3 To Say
        If Cells(Bak, "B") = "" Then
            Cells(Bak, "B") = Cells(Bak, "C")
            Cells(Bak, "C").Value = ""
        ElseIf Cells(Bak, "D") = "" Then
            Cells(Bak, "D") = Cells(Bak, "E")
            Cells(Bak, "E").Value = ""
        End If
    Next
    MsgBox "İşlem tamam.", vbInformation
End Sub

 

[Muzaffer Ali]

Buyurun.

Sub Test()
    Dim Say As Long
    Dim Bak As Long
    Say = Cells(Rows.Count, "A").End(3).Row
    For Bak = 1 To Say
        If Cells(Bak, "B") = "" Then
            Cells(Bak, "B") = Cells(Bak, "C")
            Cells(Bak, "C") = ""
        ElseIf Cells(Bak, "D") = "" Then
            Cells(Bak, "D") = Cells(Bak, "E")
            Cells(Bak, "E") = ""
        End If
    Next
    MsgBox "İşlem tamam.", vbInformation
End Sub

 

[igultekin2000]

D sütununda boş gibi görülen hücrelerde boşluk var.Onları düzeltiniz.
Buyurun.

Sub Test()
    Dim Say As Long
    Dim Bak As Long
    Say = Cells(Rows.Count, "A").End(3).Row
    For Bak = 3 To Say
        If Cells(Bak, "B") = "" Then
            Cells(Bak, "B") = Cells(Bak, "C")
            Cells(Bak, "C").Value = ""
        ElseIf Cells(Bak, "D") = "" Then
            Cells(Bak, "D") = Cells(Bak, "E")
            Cells(Bak, "E").Value = ""
        End If
    Next
    MsgBox "İşlem tamam.", vbInformation
End Sub

Teşekkür ederim sorunsuz çalıştı, iyi çalışmalar.

 

[igultekin2000]

Buyurun.

Sub Test()
    Dim Say As Long
    Dim Bak As Long
    Say = Cells(Rows.Count, "A").End(3).Row
    For Bak = 1 To Say
        If Cells(Bak, "B") = "" Then
            Cells(Bak, "B") = Cells(Bak, "C")
            Cells(Bak, "C") = ""
        ElseIf Cells(Bak, "D") = "" Then
            Cells(Bak, "D") = Cells(Bak, "E")
            Cells(Bak, "E") = ""
        End If
    Next
    MsgBox "İşlem tamam.", vbInformation
End Sub

Teşekkür ederim, sorunsuz çalıştı, iyi çalışmalar.