Veri doğrulamada formül düzenleme

[kamsal]

Ömer hocam yoğunsunuz galiba, dosyaya son bir hamle yapacaktınız..?

 

[Ömer]

Ömer hocam yoğunsunuz galiba, dosyaya son bir hamle yapacaktınız..?

Evet, bu sıralar işlerim oldukça yoğunlaştı.

Eki inceleyiniz.

.

 

[kamsal]

Ömer hocam bu yoğunlukta cevap verdiğiniz için teşekkür ederim. Ayrıca hayırlı cumalar dilerim.

Dosyada aktarma sorunu dışında tüm istediklerim tamam. Çok sağolun. Eğer boş vaktıniz olursa aktarma sorunu içinde bir göz atarsanız sevinirim. Ben dosya içinde açıklama yaparak göndereceğim.

 

[kamsal]

Dosyayı ekledim.

Bun şekilde yapılabilirmi bilmiyorum ama, yapılırsa veri girişlerinde zamandan kazanacağım. Yok böyle birşey yapılamaz derseniz bu şekliyle girişlerime başlayacağım.

 

[iibfli]

Sanırım bu şekilde birşey istiyorsunuz. Ömer üstad bakabildiğinde daha iyisini yapacaktır eminim.

 

[kamsal]

Sayın iibfli,

İlginiz için teşekkür ediyorum ama olmadı. Düzenli aktarma yapmıyor ve boşluk düğmesine bastığımda girmediğim verileri getiriyor

 

[Ömer]

Dosyayı ekledim.

Bun şekilde yapılabilirmi bilmiyorum ama, yapılırsa veri girişlerinde zamandan kazanacağım. Yok böyle birşey yapılamaz derseniz bu şekliyle girişlerime başlayacağım.

Ekteki gibi, üst tarafı tamamen boş bırakıp alt kısımdan veri girişine başlama ihtimali var mı? Yoksa ek sadece bir örnek mi?

.

 

[kamsal]

Ömer hocam ekteki örnektir. Üst kısmı boş bırakma ve alt kısımda yeni veri girişi yapma gibi bir işlem yok. Ben Her kartta bulunan verileri girip, tabloyu temizleyip yeni kart verilerini gireceğim.

 

[Ömer]

Ömer hocam ekteki örnektir. Üst kısmı boş bırakma ve alt kısımda yeni veri girişi yapma gibi bir işlem yok. Ben Her kartta bulunan verileri girip, tabloyu temizleyip yeni kart verilerini gireceğim.

#22 numaralı mesajda bulunan dosyadaki kodları aşağıdakilerle değiştiriniz.

Private Sub CommandButton1_Click()
 
    Dim Sv As Worksheet, sOnf As Long, sOnV As Long
 
    Set Sv = Sheets("Veri")
 
    sOnf = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    sOnV = Sv.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
 
    Application.ScreenUpdating = False
 
    If WorksheetFunction.CountA([A3:A65536]) = 0 Then Exit Sub
 
    Range("A3:I" & sOnf).Copy
    Sv.Range("A" & sOnV).PasteSpecial xlPasteValues, xlNone
    Application.CutCopyMode = False
 
    Range("A3:I" & Rows.Count).ClearContents
 
    Application.ScreenUpdating = True
 
    MsgBox "Aktarım Tamamlandı", vbInformation
 
End Sub

.

 

[kamsal]

Ömer hocam

hakikaten sizi çok yordum, hakkınızı helal edin.

Dosyada son durum şöyle;
KISIM-MAKİNE-TARİH bilgilerini tek olarak aktarıyor. Yani dolu olan diğer satırlarla eşleştirmiyor...!
verdiğiniz kodu diğeri ile değiştirdim ama 22 numaralı mesajda bulunan dosyada bu değişikliği yaptım.

????

 

[Ömer]

Sorun nedir. Sorularınızı açıklarken detaya inmenizi rica ederim.

 

[kamsal]

Ömer hocam sorun şöyle;
verdiğiniz kodu yapıştırdıktan sonra, "aktar" dediğimde tarih-kısım-makine bilgilerini tek satır olarak aktarıyor. Diğer bilgileri ise istediğim şekilde aktarıyor.
Ayrıca "aktardıktan sonra" veri sayfasında satır başlıkları yok oluyor ve girdiğim veriler ilk baştaki satırdan başlıyor.

 

[Ömer]

Ben bir hata almamıştım.

Aşağıdaki açıkladığım 2 dosya şeklini rar layıp eklermisiniz.

İlk dosya, hata aldığınız verilerin butona basmadan önceki hali olsun. İkinci dosya ise butona bastıktan sonra olmasını istediğiniz biçim nasılsa o biçimi manuel tabloda yazınız.

.

 

[kamsal]

Merhaba Ömer hocam hayırlı sabahlar,

Ben son dosyayı yine ekliyorum,

Dosyada "veri" sayfasında manuel olarak olması gereken tablo girişini yaptım.

Ve aktarmada yaşanan problemleri açıklama olarak yazdım.

Aktarma esnasında herhangi bir "hata" uyarısı almıyorum, sadece eksik ve düzensiz aktarıyor..

 

[kamsal]

Dosyanın bir önceki halini eklemeyi unutmuşum.. ektedir.

 

[Ömer]

Dosyanın bir önceki halini eklemeyi unutmuşum.. ektedir.

Kodları aşağıdakilerle değiştiriniz.

Private Sub CommandButton1_Click()
 
    Dim Sv As Worksheet, sOnf As Long, sOnV As Long, sOnY As Long
 
    Set Sv = Sheets("Veri")
 
    sOnf = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    sOnV = Sv.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
 
    Application.ScreenUpdating = False
    On Error GoTo Devam
      
    If WorksheetFunction.CountA([A3:A65536]) = 0 Then Exit Sub
 
    Range("A3:I" & sOnf).Copy
    Sv.Range("A" & sOnV).PasteSpecial xlPasteValues, xlNone
    Application.CutCopyMode = False
 
    Range("A3:I" & Rows.Count).ClearContents
    
    Sheets("Veri").Select
    sOnY = Sv.Cells.Cells.Find("*", , , , xlByRows, xlPrevious).Row
    
    Sv.Range("A2:C" & sOnY).SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
 
Devam:
    Sv.Range("A1").Select
    Application.ScreenUpdating = True
 
    MsgBox "Aktarım Tamamlandı", vbInformation
 
End Sub

.

 

[kamsal]

Ömer hocam tam istediğim gibi harika oldu. Son bir işlemi kaldı...

"süre" kısmına sabit formül yerleştirmek. Mevcut dosyada her defasında manuel olarak "çıkarma" formülü koyuyorum. Ama aktarma sonrası formülde kayboluyor...

Bunun içinde bir şey yapabilirsek işlem tamamdır hocam...

 

[Ömer]

Kodları yazdığınız sayfaya aşağıdaki kodları da ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Intersect(Target, [G3:H65000]) Is Nothing Then Exit Sub
 
    Range("I" & Target.Row) = "=H" & Target.Row & "-G" & Target.Row & ""
 
End Sub

.

 

[kamsal]

Ömer hocam bu kodları diğer kodların en altına mı eklemem gerekiyor??

 

[Ömer]

Bu kodlar diğerinden bağımsızdır. Kırmızı bölüme yani diğer kodlardaki end sub satırından sonra yeni kodları ekleyin.

Private Sub CommandButton1_Click()

eski kodlar.

End Sub

son verdiğim kodlar.

.