Soru Belirli Hücreleri Taşırken Sütun Birleştirme ?

MiRaBiLiS · 19 Ekim 2018

Merhaba sayın üstatlar.

bu aralar ismim sıkça görülür oldu bu sayfalarda ama yine yardıma ihtiyacım oldu ve yardım dediğimde yardımıma koşan yegane yer burası..

iki dosyam mevcut. form dosyasında verileri girdiğimde ve günlüğe aktar dediğimde girilen bilgileri günlüğün son satırına aktarıyor.
ancak raporlamada şöyle bir sorun çıkmakta. 1 kalemlik sevkiyat olduğunda sıkıntı yok ama 5-6 kalemlik sevkiyat olduğunda raporlamada bunların hepsini farklı birer sevkiyat olarak görmekte. aslında bir araç ile 1 çeşitte 33 çeşitte ürün gelebilir.

benim sizden ricam, günlüğe aktar dediğimizde, kaç kalem aktarıyorsa Firma Adı, sevkiyat tarihi, plaka, E sütunundaki M ve Y yazan satırlar, teslim alan kısmı bölümlerinin tek bir sevkiyat olduğunu anlamamız ve raporda gerçek günlük araç sayısını görmemiz için birleştirmektir. günlükte örnek olması için veriler mevcut. oradan fikir sahibi olabilirsiniz.

Şimdiden emeğiniz için teşekkür ediyorum.

form ve günlük dosyasının linki: https://www.dosyaupload.com/myUv

form içerisinde günlüğe aktarım yapan kod aşağıdaki gibidir.

Kod:

Private Sub CommandButton4_Click()
CommandButton3.Enabled = True
CommandButton4.Enabled = False

Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim historyWks, busayfa As Worksheet

filter = "Text files (*.xlsm),*.xlsm"

caption = "Lütfen Dosya Seçiniz "
customerFilename = "C:\Users\Ofis1\YandexDisk\SEVKIYAT\GUNLUK.xlsm"
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Set busayfa = ThisWorkbook.ActiveSheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False


For i = 6 To 38

    sat = customerWorkbook.Worksheets(1).Cells(65536, "B").End(xlUp).Row

    If busayfa.Range("E" & i).Value <> 0 Then
        customerWorkbook.Worksheets(1).Range("A" & sat + 1).Value = busayfa.Range("A3").Value
        customerWorkbook.Worksheets(1).Range("B" & sat + 1).Value = busayfa.Range("B3").Value
        customerWorkbook.Worksheets(1).Range("D" & sat + 1).Value = busayfa.Range("D3").Value
        customerWorkbook.Worksheets(1).Range("P" & sat + 1).Value = busayfa.Range("A41").Value
        customerWorkbook.Worksheets(1).Range("Q" & sat + 1).Value = busayfa.Range("C41").Value
        customerWorkbook.Worksheets(1).Range("J" & sat + 1).Value = busayfa.Range("D41").Value
        customerWorkbook.Worksheets(1).Range("K" & sat + 1).Value = busayfa.Range("E41").Value
        customerWorkbook.Worksheets(1).Range("L" & sat + 1).Value = busayfa.Range("F41").Value
        customerWorkbook.Worksheets(1).Range("M" & sat + 1).Value = busayfa.Range("H41").Value
        customerWorkbook.Worksheets(1).Range("S" & sat + 1).Value = busayfa.Range("I41").Value
        customerWorkbook.Worksheets(1).Range("T" & sat + 1).Value = busayfa.Range("B44").Value
        customerWorkbook.Worksheets(1).Range("N" & sat + 1).Value = busayfa.Range("C47").Value
        customerWorkbook.Worksheets(1).Range("O" & sat + 1).Value = busayfa.Range("M2").Value
        customerWorkbook.Worksheets(1).Range("R" & sat + 1).Value = busayfa.Range("D56").Value
        customerWorkbook.Worksheets(1).Range("C" & sat + 1).Value = busayfa.Range("E3").Value
       
        customerWorkbook.Worksheets(1).Range("F" & sat + 1).Value = busayfa.Range("E" & i).Value
        customerWorkbook.Worksheets(1).Range("H" & sat + 1).Value = busayfa.Range("H" & i).Value
        customerWorkbook.Worksheets(1).Range("I" & sat + 1).Value = busayfa.Range("I" & i).Value
        customerWorkbook.Worksheets(1).Range("G" & sat + 1).Value = busayfa.Range("B" & i).Value
    End If

Next i

customerWorkbook.Save
customerWorkbook.Close
MsgBox "Aktarım Tamamlandı!" & Alt _


End Sub

turist · 20 Ekim 2018

Yukarıdaki konu başlığınıza yardım bekliyorsanız, uzun bir açıklama yazmış olsanız da;
FORM Dosyanızın "DEPO GİRİŞ-ÇIKIŞ"sayfasında hiçbir veri yok.Hücreler, dış kaynaktan "İbrahim\Desktop\[KAYNAK].xlsm" dosyasından veri aldığı için; sizin bilgisayarınızda görülse bile bu dosyada görülemiyor.
Öncelikle FORM dosyanıza verileri Formülsüz biçimde elle sorunuza örnek olacak şekilde doldurun.
Bu sayfadaki hangi verilerin(Hangi hücrelerin) GÜNLÜK dosyasında hangi hücre/hücrelerde birleştirilmesi gerektiğini belirtin.
Daha da önemlisi; FORM dosyanızdaki SAYFA KORUMASINI kaldırın.

Umarım, bundan sonra cevap bulma şansınız artacaktır.

MiRaBiLiS · 20 Ekim 2018

turist' Alıntı:
Yukarıdaki konu başlığınıza yardım bekliyorsanız, uzun bir açıklama yazmış olsanız da;
FORM Dosyanızın "DEPO GİRİŞ-ÇIKIŞ"sayfasında hiçbir veri yok.Hücreler, dış kaynaktan "İbrahim\Desktop\[KAYNAK].xlsm" dosyasından veri aldığı için; sizin bilgisayarınızda görülse bile bu dosyada görülemiyor.
Öncelikle FORM dosyanıza verileri Formülsüz biçimde elle sorunuza örnek olacak şekilde doldurun.
Bu sayfadaki hangi verilerin(Hangi hücrelerin) GÜNLÜK dosyasında hangi hücre/hücrelerde birleştirilmesi gerektiğini belirtin.
Daha da önemlisi; FORM dosyanızdaki SAYFA KORUMASINI kaldırın.

Umarım, bundan sonra cevap bulma şansınız artacaktır.

Çok Özür Diliyorum Üstat, Şifreyi kaldırdığımı sanmıştım.

https://www.dosyaupload.com/mz7t

Yeni Dosya Linki budur. dosyanın içerisinde de gerekli açıklamalar mevcut. form dosyasında düzenlemeden sonra olması gereken haliyle bir örnek günlük dosyası koydum oradan bakarsanız nasıl bir mantıkta birşey istediğimi anlayabilirsiniz.

tekrardan kusura bakmayın. aceleme gelmiş olmalı.

turist · 20 Ekim 2018

Dosyalarınızda yer alan bilgileri ve RAPOR ihtiyacınızı birlikte değerlendirirsek, tespitlerim ve kanaatim;
Tespitler:
"Örnek Günlük" olarak oluşturduğunuz sayfada "Biçimlendirme" yönünden hatalar var, örneklemek istediğiniz net olarak anlaşılmıyor.Bazı hücreler "birleştirilmiş" bazıları aynı bilgiler olmasına rağmen birleştirilmemiş.(Örnek 10-11 satırlar birleşik, 12. satır tek ???) B-C-E-N-R sütunlarına göre birleştirme olacak ise hatalı değil mi?

Bunun dışında tabii ki birleştirilmeyecek tek satırlık işlemler de var.

Bu durum, hem GÜNLÜK sayfasına aktarma, hem de RAPOR için gereken bilgileri elde etme aşamasında sorun yaratacaktır.(İmkansız değil, ancak çözümü karmaşık hale zorlayacaktır.)

Tavsiyem:
-C-E-N-R sütunlarına yazılacak diye tanımlanan bilgiler, birleştirilmemiş tek satırlık bilgiler olursa sonuca daha kolay ulaşılacaktır.
GÜNLÜK dosyanızda "Yeni" bir çalışma sayfası açıp, RAPOR için gerekli bilgileri,( yani Raporda analizi, tablosu, grafiği yapılacak yeterli bilgileri B-C-E-N-R sütunlarına yazılması gereken "tek satırlık bilgileri) , bu "yeni" sayfaya ayrıca yazdırmak ve RAPOR işlemlerini bu sayfadan alınacak verilerle sağlamak.
Bu işlemler mevcut GÜNLÜK listesine aktarma işlemine "EK" olarak; mevcut makro koduna ilave ile veya başka bir kod düzenlemesi ile yapılabilir.

Yukarıda belirttiğim hususları değerlendirip görüşünüzü bildirirseniz; dosyalarınızla ilgili çalışmaya cevap bulmanıza ve çözüm sağlamak isteyen üye arkadaşlarımıza faydası ve yardımı olur.
İyi çalışmalar.

MiRaBiLiS · 20 Ekim 2018

Hocam peki, şöyle birşey yapabilirmiyiz bu işlem gereksiz uğraşı gerektirecek ise,
ilk bu işi düşündüğümde günlüğe aktar kısmına birde sayaç eklemeyi ve benzersiz şekilde sürekli sayının +1 artarak her kayıta verilmesini düşünmüştüm ancak, bizim form sayfamız salt okunur olarak açılıp formüllerin bozulmasını engelliyoruz. bu sayaç işi o yüzden iptal oldu. ama yeni upload ettiğim dosyada bir örnek günlük daha ekledim son sütuna sıra numarası her kayıt için ayrı ayrı verilmesi mümkün olabilir ise buda işimi görecektir. hücre birleştirmek yerine her sevkiyatın bir sıra numarası olur ise o sıra numarası değerine göre sevkiyatları tabloda gösterebilirim. böylece net değerler vermiş olur.

ekte son dosya mevcut bu veriler ile yaptığım örnek grafik tabloları da mevcut. ikisi de aynı değeri veriyor. yani iki yollada sorun çözülmüş olacak.

https://www.dosyaupload.com/mz8i

turist · 21 Ekim 2018

Önerdiğiniz şekilde işlem yapmanız için, aşağıdaki kodda yapılan ekleme ve düzeltme ile Normal GÜNLÜK dosyanızdaki "ANA" sayfanıza kayıt yaparken "V" sütununa işlem numarası verecektir.
Ancak daha önceki kayıtlarınızı "örnek günlük dosyasındaki gibi eski işlem numaralarını vererek kodu deneyebilirsiniz.

Rich (BB code):

Private Sub CommandButton4_Click()
CommandButton3.Enabled = True
CommandButton4.Enabled = False

Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim historyWks, busayfa As Worksheet

filter = "Text files (*.xlsm),*.xlsm"

caption = "Lütfen Dosya Seçiniz "
customerFilename = "P:\SEVKIYAT\GUNLUK.xlsm"
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Set busayfa = ThisWorkbook.ActiveSheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 6 To 38
    sat = customerWorkbook.Worksheets(1).Cells(65536, "B").End(xlUp).Row
    Say = Application.Max(customerWorkbook.Worksheets(1).Range("V2:V" & sat))
    If busayfa.Range("E" & i).Value <> 0 Then
      
        customerWorkbook.Worksheets(1).Range("V" & sat + 1) = Say + 1
        customerWorkbook.Worksheets(1).Range("A" & sat + 1).Value = busayfa.Range("A3").Value
        customerWorkbook.Worksheets(1).Range("A" & sat + 1).Value = busayfa.Range("A3").Value
        customerWorkbook.Worksheets(1).Range("B" & sat + 1).Value = busayfa.Range("B3").Value
        customerWorkbook.Worksheets(1).Range("D" & sat + 1).Value = busayfa.Range("D3").Value
        customerWorkbook.Worksheets(1).Range("P" & sat + 1).Value = busayfa.Range("A41").Value
        customerWorkbook.Worksheets(1).Range("Q" & sat + 1).Value = busayfa.Range("C41").Value
        customerWorkbook.Worksheets(1).Range("J" & sat + 1).Value = busayfa.Range("D41").Value
        customerWorkbook.Worksheets(1).Range("K" & sat + 1).Value = busayfa.Range("E41").Value
        customerWorkbook.Worksheets(1).Range("L" & sat + 1).Value = busayfa.Range("F41").Value
        customerWorkbook.Worksheets(1).Range("M" & sat + 1).Value = busayfa.Range("H41").Value
        customerWorkbook.Worksheets(1).Range("S" & sat + 1).Value = busayfa.Range("I41").Value
        customerWorkbook.Worksheets(1).Range("T" & sat + 1).Value = busayfa.Range("B44").Value
        customerWorkbook.Worksheets(1).Range("N" & sat + 1).Value = busayfa.Range("C47").Value
        customerWorkbook.Worksheets(1).Range("O" & sat + 1).Value = busayfa.Range("M2").Value
        customerWorkbook.Worksheets(1).Range("R" & sat + 1).Value = busayfa.Range("D56").Value
        customerWorkbook.Worksheets(1).Range("C" & sat + 1).Value = busayfa.Range("E3").Value
        customerWorkbook.Worksheets(1).Range("E" & sat + 1).Value = busayfa.Range("C3").Value
        
        customerWorkbook.Worksheets(1).Range("F" & sat + 1).Value = busayfa.Range("E" & i).Value
        customerWorkbook.Worksheets(1).Range("H" & sat + 1).Value = busayfa.Range("H" & i).Value
        customerWorkbook.Worksheets(1).Range("I" & sat + 1).Value = busayfa.Range("I" & i).Value
        customerWorkbook.Worksheets(1).Range("G" & sat + 1).Value = busayfa.Range("B" & i).Value
  End If
  Next i
customerWorkbook.Save
customerWorkbook.Close
MsgBox "Import İşlemi Başarıyla Tamamlandı!" & Alt _


End Sub

MiRaBiLiS · 22 Ekim 2018

turist' Alıntı:

Önerdiğiniz şekilde işlem yapmanız için, aşağıdaki kodda yapılan ekleme ve düzeltme ile Normal GÜNLÜK dosyanızdaki "ANA" sayfanıza kayıt yaparken "V" sütununa işlem numarası verecektir.
Ancak daha önceki kayıtlarınızı "örnek günlük dosyasındaki gibi eski işlem numaralarını vererek kodu deneyebilirsiniz.

Rich (BB code):

Private Sub CommandButton4_Click()
CommandButton3.Enabled = True
CommandButton4.Enabled = False

Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim historyWks, busayfa As Worksheet

filter = "Text files (*.xlsm),*.xlsm"

caption = "Lütfen Dosya Seçiniz "
customerFilename = "P:\SEVKIYAT\GUNLUK.xlsm"
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Set busayfa = ThisWorkbook.ActiveSheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 6 To 38
    sat = customerWorkbook.Worksheets(1).Cells(65536, "B").End(xlUp).Row
    Say = Application.Max(customerWorkbook.Worksheets(1).Range("V2:V" & sat))
    If busayfa.Range("E" & i).Value <> 0 Then
    
        customerWorkbook.Worksheets(1).Range("V" & sat + 1) = Say + 1
        customerWorkbook.Worksheets(1).Range("A" & sat + 1).Value = busayfa.Range("A3").Value
        customerWorkbook.Worksheets(1).Range("A" & sat + 1).Value = busayfa.Range("A3").Value
        customerWorkbook.Worksheets(1).Range("B" & sat + 1).Value = busayfa.Range("B3").Value
        customerWorkbook.Worksheets(1).Range("D" & sat + 1).Value = busayfa.Range("D3").Value
        customerWorkbook.Worksheets(1).Range("P" & sat + 1).Value = busayfa.Range("A41").Value
        customerWorkbook.Worksheets(1).Range("Q" & sat + 1).Value = busayfa.Range("C41").Value
        customerWorkbook.Worksheets(1).Range("J" & sat + 1).Value = busayfa.Range("D41").Value
        customerWorkbook.Worksheets(1).Range("K" & sat + 1).Value = busayfa.Range("E41").Value
        customerWorkbook.Worksheets(1).Range("L" & sat + 1).Value = busayfa.Range("F41").Value
        customerWorkbook.Worksheets(1).Range("M" & sat + 1).Value = busayfa.Range("H41").Value
        customerWorkbook.Worksheets(1).Range("S" & sat + 1).Value = busayfa.Range("I41").Value
        customerWorkbook.Worksheets(1).Range("T" & sat + 1).Value = busayfa.Range("B44").Value
        customerWorkbook.Worksheets(1).Range("N" & sat + 1).Value = busayfa.Range("C47").Value
        customerWorkbook.Worksheets(1).Range("O" & sat + 1).Value = busayfa.Range("M2").Value
        customerWorkbook.Worksheets(1).Range("R" & sat + 1).Value = busayfa.Range("D56").Value
        customerWorkbook.Worksheets(1).Range("C" & sat + 1).Value = busayfa.Range("E3").Value
        customerWorkbook.Worksheets(1).Range("E" & sat + 1).Value = busayfa.Range("C3").Value
      
        customerWorkbook.Worksheets(1).Range("F" & sat + 1).Value = busayfa.Range("E" & i).Value
        customerWorkbook.Worksheets(1).Range("H" & sat + 1).Value = busayfa.Range("H" & i).Value
        customerWorkbook.Worksheets(1).Range("I" & sat + 1).Value = busayfa.Range("I" & i).Value
        customerWorkbook.Worksheets(1).Range("G" & sat + 1).Value = busayfa.Range("B" & i).Value
  End If
  Next i
customerWorkbook.Save
customerWorkbook.Close
MsgBox "Import İşlemi Başarıyla Tamamlandı!" & Alt _


End Sub

üstat yolumuz doğru, ancak şöyle bir durum var örneğimde de bunu örnek günlükte yazmıştım. umarım yazı ile anlatabilirim.
bir formu gönderdiğimde sadece ilk satırına +1 değeri verecek, sonra farklı bir form gönderdiğimde günlükteki v stünuna bakarak son yazılan rakama +1 koyacak. yani her sevkiyata ister 1 kalemlik ister 5 kalemlik olsa da 1 tek +1 koyacak. sizin yaptığınızda her kaleme +1 koyduğu için sıkıntı devam etmekte. bunu şu şekilde yapabiliriz. sonuçta her sevkiyatta mecburen B6 hücresi dolu olacak 1 kalemlikte olsa 10 kalemlik bir sevkiyatta olsa. sadece o satırın devamında v sütununa +1 koymasını ve yeni bir form kaydında yine üstteki sayıyı kontrol edip ona +1 koymasını sağlayabilirmiyiz.

turist · 22 Ekim 2018

Aşağıdaki gibi deneyin.
Not: "GUNLUK" isimli dosyanızın "ANA" sayfasına kayıt yazdırmadan önce, sayfada daha önceden kaydedilenlere , örnekte olduğu gibi sıra numaralarını "elle" yazın, sonrasında makro kodunu çalıştırın.

Rich (BB code):

Private Sub CommandButton4_Click()
CommandButton3.Enabled = True
CommandButton4.Enabled = False

Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim historyWks, busayfa As Worksheet

filter = "Text files (*.xlsm),*.xlsm"

caption = "Lütfen Dosya Seçiniz "
customerFilename = "P:\SEVKIYAT\GUNLUK.xlsm"
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Set busayfa = ThisWorkbook.ActiveSheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 Saysat = customerWorkbook.Worksheets(1).Cells(65536, "B").End(xlUp).Row
 Say = Application.Max(customerWorkbook.Worksheets(1).Range("V2:V" & Saysat))
    If busayfa.Range("E6").Value <> 0 Then
      customerWorkbook.Worksheets(1).Range("V" & Saysat + 1) = Say + 1
 Else: Exit Sub: End If
For i = 6 To 38
    sat = customerWorkbook.Worksheets(1).Cells(65536, "B").End(xlUp).Row
    If busayfa.Range("E" & i).Value <> 0 Then
        customerWorkbook.Worksheets(1).Range("A" & sat + 1).Value = busayfa.Range("A3").Value
        customerWorkbook.Worksheets(1).Range("B" & sat + 1).Value = busayfa.Range("B3").Value
        customerWorkbook.Worksheets(1).Range("D" & sat + 1).Value = busayfa.Range("D3").Value
        customerWorkbook.Worksheets(1).Range("P" & sat + 1).Value = busayfa.Range("A41").Value
        customerWorkbook.Worksheets(1).Range("Q" & sat + 1).Value = busayfa.Range("C41").Value
        customerWorkbook.Worksheets(1).Range("J" & sat + 1).Value = busayfa.Range("D41").Value
        customerWorkbook.Worksheets(1).Range("K" & sat + 1).Value = busayfa.Range("E41").Value
        customerWorkbook.Worksheets(1).Range("L" & sat + 1).Value = busayfa.Range("F41").Value
        customerWorkbook.Worksheets(1).Range("M" & sat + 1).Value = busayfa.Range("H41").Value
        customerWorkbook.Worksheets(1).Range("S" & sat + 1).Value = busayfa.Range("I41").Value
        customerWorkbook.Worksheets(1).Range("T" & sat + 1).Value = busayfa.Range("B44").Value
        customerWorkbook.Worksheets(1).Range("N" & sat + 1).Value = busayfa.Range("C47").Value
        customerWorkbook.Worksheets(1).Range("O" & sat + 1).Value = busayfa.Range("M2").Value
        customerWorkbook.Worksheets(1).Range("R" & sat + 1).Value = busayfa.Range("D56").Value
        customerWorkbook.Worksheets(1).Range("C" & sat + 1).Value = busayfa.Range("E3").Value
        customerWorkbook.Worksheets(1).Range("E" & sat + 1).Value = busayfa.Range("C3").Value
        
        customerWorkbook.Worksheets(1).Range("F" & sat + 1).Value = busayfa.Range("E" & i).Value
        customerWorkbook.Worksheets(1).Range("H" & sat + 1).Value = busayfa.Range("H" & i).Value
        customerWorkbook.Worksheets(1).Range("I" & sat + 1).Value = busayfa.Range("I" & i).Value
        customerWorkbook.Worksheets(1).Range("G" & sat + 1).Value = busayfa.Range("B" & i).Value
    End If

Next i

customerWorkbook.Save
customerWorkbook.Close
MsgBox "Import İşlemi Başarıyla Tamamlandı!" & Alt _


End Sub

MiRaBiLiS · 24 Ekim 2018

Hocam işte olay budur. eline aklına sağlık. teşekkür ediyorum. gayet güzel çalışıyor.
Allah razı olsun..

bu konu ile ilgili değil ama yeni konu açmadan senin görüşünü almak için buraya eklemeyi uygun gördüğüm bir sorum vardı.
Ağda(Aslında bulutta) iki bilgisayarın ortak veri yazdığı bir excel dosyası var. bir bilgisayarda o dosyadan verileri çağıran formüller sorunsuz çalışıyor ama diğerinde bazı verileri okuyor bazılarını ise ortak dosyaya girip f2 ile hücreyi editleyip enter yapınca okuyor. bu sorun hakkında bir bilgin var mıdır acaba hocam? tüm hücrelerin içine girip f2 + enter yapmadan bunu nasıl çözebiliriz.

turist · 24 Ekim 2018

MiRaBiLiS' Alıntı:
Hocam işte olay budur. eline aklına sağlık. teşekkür ediyorum. gayet güzel çalışıyor.
Allah razı olsun..

Sağ olun, iyi çalışmalar.

MiRaBiLiS · 24 Ekim 2018

turist' Alıntı:
Sağ olun, iyi çalışmalar.

hocam teşekkür mesajına bi editleme yapmıştım da bi okur musunuz? garip bi olay var da konu açmadan size bi danışayım dedim önce.

turist · 24 Ekim 2018

MiRaBiLiS' Alıntı:
hocam teşekkür mesajına bi editleme yapmıştım da bi okur musunuz? garip bi olay var da konu açmadan size bi danışayım dedim önce.

Aşağıdaki kodu, VBA sayfasında "ThisWorkbook" (BuÇalışmakitabı) kısmına ekleyip deneyin.

Kod:

Private Sub Workbook_Open()
Application.ScreenUpdating = False
For Each sayfa In ThisWorkbook.Worksheets
Dim hucre As Range
    For Each hucre In Cells.SpecialCells(xlCellTypeFormulas)
    hucre.Calculate
    Next hucre
    Next sayfa
Application.ScreenUpdating = True
End Sub

MiRaBiLiS · 25 Ekim 2018

turist' Alıntı:
Aşağıdaki kodu, VBA sayfasında "ThisWorkbook" (BuÇalışmakitabı) kısmına ekleyip deneyin.

Kod:

Private Sub Workbook_Open() Application.ScreenUpdating = False For Each sayfa In ThisWorkbook.Worksheets Dim hucre As Range For Each hucre In Cells.SpecialCells(xlCellTypeFormulas) hucre.Calculate Next hucre Next sayfa Application.ScreenUpdating = True End Sub

Malesef deneyemedim hocam. Koruma kilitli hücrelerde işlem hatası verdi. hücreleri kilitlememe gibi bir imkanım da malesef yok. bazı hücrelere veri girişi yapmamaları gerekli.
kilitli hücrelerde sorun vermeyecek bir çözümü mevcut mudur acaba?

turist · 25 Ekim 2018

Bulut'taki dosyada kaç tane sayfa var ve "Sayfa Korumalı" ise şifreleri nedir?

MiRaBiLiS · 25 Ekim 2018

turist' Alıntı:
Bulut'taki dosyada kaç tane sayfa var ve "Sayfa Korumalı" ise şifreleri nedir?

1. olarak form dosyamız var onda 5 şifreli 2 de şifresiz 7 sayfa bulunuyor. şifresi: QAZ123
2. olarak stok dosyamız mevcut, onda ise 24 sayfa mevcut. şifresi: QAZ ama ana ekranın şifresi: QAZ123 (gerekirse değiştirip standart yapabilirim.)

sadece bu iki dosya KAYNAK excelinden veri çekiyor. ve ikisinde de aynı sorunla karşılaşıyorum.

turist · 25 Ekim 2018

1.form dosyanızda "şifresiz" olan sayfaların isimleri nedir?
2. stok dosyanızda, form dosyanızdaki şifresiz isimlerle aynı isimde sayfa(lar) var mıdır?

MiRaBiLiS · 26 Ekim 2018

form dosyamda şifresi 2 sayfam var: isimleri; YAG-OTO ve YAG-EL

stok dosyamda da şifresiz bir sayfa mevcutmuş, ismi: ARAMA

iki dosyada çakışan hiçbir sayfa ismi bulunmuyor.

turist · 26 Ekim 2018

Her iki dosyanızdada şifrelerin hepsini "QAZ123" olarak belirledikten sonra

Form Dosyanız için:

Kod:

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim ws As Worksheet
 For Each ws In ThisWorkbook.Worksheets
 On Error Resume Next
 If ws.Name <> "YAG-OTO" And ws.Name <> "YAG-EL" Then
   ws.Unprotect Password:="QAZ123"
   End If
 Next ws
For Each sayfa In ThisWorkbook.Worksheets
Dim hucre As Range
    For Each hucre In Cells.SpecialCells(xlCellTypeFormulas)
    hucre.Calculate
    Next hucre
    Next sayfa
    For Each ws In ThisWorkbook.Worksheets
 On Error Resume Next
 If ws.Name <> "YAG-OTO" And ws.Name <> "YAG-EL" Then
   ws.Protect Password:="QAZ123"
   End If
 Next ws
    
Application.ScreenUpdating = True
End Sub

stok dosyanız için:

Kod:

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim ws As Worksheet
 For Each ws In ThisWorkbook.Worksheets
 On Error Resume Next
 If ws.Name <> "ARAMA" Then
   ws.Unprotect Password:="QAZ123"
   End If
 Next ws
For Each sayfa In ThisWorkbook.Worksheets
Dim hucre As Range
    For Each hucre In Cells.SpecialCells(xlCellTypeFormulas)
    hucre.Calculate
    Next hucre
    Next sayfa
    For Each ws In ThisWorkbook.Worksheets
 On Error Resume Next
 If ws.Name <> "ARAMA" Then
   ws.Protect Password:="QAZ123"
   End If
 Next ws
    
Application.ScreenUpdating = True
End Sub

kullanıp deneyin.Umarım işinize yarar.
İyi çalışmalar.

MiRaBiLiS · 26 Ekim 2018

turist' Alıntı:

Her iki dosyanızdada şifrelerin hepsini "QAZ123" olarak belirledikten sonra

Form Dosyanız için:

Kod:

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
On Error Resume Next
If ws.Name <> "YAG-OTO" And ws.Name <> "YAG-EL" Then
   ws.Unprotect Password:="QAZ123"
   End If
Next ws
For Each sayfa In ThisWorkbook.Worksheets
Dim hucre As Range
    For Each hucre In Cells.SpecialCells(xlCellTypeFormulas)
    hucre.Calculate
    Next hucre
    Next sayfa
    For Each ws In ThisWorkbook.Worksheets
On Error Resume Next
If ws.Name <> "YAG-OTO" And ws.Name <> "YAG-EL" Then
   ws.Protect Password:="QAZ123"
   End If
Next ws
   
Application.ScreenUpdating = True
End Sub

stok dosyanız için:

Kod:

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
On Error Resume Next
If ws.Name <> "ARAMA" Then
   ws.Unprotect Password:="QAZ123"
   End If
Next ws
For Each sayfa In ThisWorkbook.Worksheets
Dim hucre As Range
    For Each hucre In Cells.SpecialCells(xlCellTypeFormulas)
    hucre.Calculate
    Next hucre
    Next sayfa
    For Each ws In ThisWorkbook.Worksheets
On Error Resume Next
If ws.Name <> "ARAMA" Then
   ws.Protect Password:="QAZ123"
   End If
Next ws
   
Application.ScreenUpdating = True
End Sub

kullanıp deneyin.Umarım işinize yarar.
İyi çalışmalar.

Hocam birşey ters gitti sanırım. iki dosyada da kodları thisworkbook a ekledim yanlış birşey yaptığımı sanmıyorum hocam.

turist · 27 Ekim 2018

Sayın @MiRaBiLiS ,
Konu ile ilgili bilgilendirmeler sonucunda, dosyalarınız ile ilgili sorun(lar) çözüldü ise, konu başlığınızı "Çözüldü" olarak değiştirebilirsiniz.
İyi çalışmalar.

Soru Belirli Hücreleri Taşırken Sütun Birleştirme ?

MiRaBiLiS

turist

Destek Ekibi

MiRaBiLiS

turist

Destek Ekibi

MiRaBiLiS

turist

Destek Ekibi

MiRaBiLiS

turist

Destek Ekibi

MiRaBiLiS

turist

Destek Ekibi

MiRaBiLiS

turist

Destek Ekibi

MiRaBiLiS

turist

Destek Ekibi

MiRaBiLiS

turist

Destek Ekibi

MiRaBiLiS

turist

Destek Ekibi

MiRaBiLiS

turist

Destek Ekibi