- Katılım
- 19 Mayıs 2015
- Mesajlar
- 239
- Excel Vers. ve Dili
- 2010 türkçe
- Altın Üyelik Bitiş Tarihi
- 09-07-2021
Herkese merhaba,
Yapmak istediğim şeyi tam ifade edebilmek için ekteki zip içinde iki adet dosya mevcut. Dosyalardan "Numune Kabul ve Kayıt 1" isimli dosyaya veri girişi yapıldıkça gizli olan F sütunundaki veriler bir kod vasıtasıyla "Parametre Dağılım" isimli dosyada ilgili kısımlara geliyor.İlgili kod aşağıdadır.
Benim yapmak istediğim şeye gelirsek, ben bu iki dosyayı ayrı ayrı bilgisayarlara koyarak ağ üzerinden eşleştirmek istiyorum.Bu mümkün mü?
Mümkün ise kod içinde nasıl bir değişiklik yapmak gerekiyor.
Teşekkürler..
Yapmak istediğim şeyi tam ifade edebilmek için ekteki zip içinde iki adet dosya mevcut. Dosyalardan "Numune Kabul ve Kayıt 1" isimli dosyaya veri girişi yapıldıkça gizli olan F sütunundaki veriler bir kod vasıtasıyla "Parametre Dağılım" isimli dosyada ilgili kısımlara geliyor.İlgili kod aşağıdadır.
Kod:
Sub auto_open()
Call clock
End Sub
Sub clock()
Application.OnTime Now + TimeValue("00:00:30"), "hesapla"
End Sub
Sub hesapla()
Dim wb_Numune, wb_Parametre As Workbook
For Each vb In Workbooks
If vb.Name = "NUMUNE KABUL VE KAYIT 1.xlsm" Then
Set wb_Numune = Application.Workbooks(vb.Name)
End If
If vb.Name = "Parametre Dağılım.xlsm" Then
Set wb_Parametre = Application.Workbooks(vb.Name)
End If
Next
If IsEmpty(wb_Numune) Then
'Numune Sayfası açık değil
GoTo son:
End If
s = Array("", "NUMUNE KAYIT KABUL")
Dim S1, S2 As Worksheet
Set S2 = wb_Parametre.Sheets("parametre dağılım")
S2.Range("F2") = Format(Now, "hh:mm:ss")
S2.Range("A4:AJ" & Rows.Count).ClearContents
For i = 1 To UBound(s)
Set S1 = wb_Numune.Sheets(i)
son = S1.Cells(Rows.Count, "F").End(3).Row
For Each alan In S1.Range("J6:AU" & son)
If UCase(alan) = "X" Then
sat = S2.Cells(Rows.Count, alan.Column - 9).End(3).Row + 1
S2.Cells(sat, alan.Column - 9) = S1.Cells(alan.Row, "F")
End If
Next
Next i
son:
Call clock
End Sub
Mümkün ise kod içinde nasıl bir değişiklik yapmak gerekiyor.
Teşekkürler..
Ekli dosyalar
-
86.2 KB Görüntüleme: 2