Kapalı Tablodan Değer Getirme..

_GÜRCAN_ · 26 Kasım 2018

Sanayi Tüketim Raporu Tablosunda
C5'E Yazdığım firma adı ve D5'e belirtilen tarihe göre

kapalı dosya (günlük) sayfalardan
E5'e Günlükten D15'i
F5'e Günlükten E15'i

Sanayi Tüketim Raporu Tablosunda
C5'E Yazdığım firma adı ve G5'e belirtilen tarihe göre

kapalı dosya (günlük) sayfalardan
H5'e Günlükten D16'yı
I5'e Günlükten E16'yı

Değerleri getirmemiz mümkünmüdür.

Yardımlarınız için şimdiden teşekkürler.

_GÜRCAN_ · 26 Kasım 2018

Forumdaki büyüklerim
Gönderdiğim tablolar açıklayıcı olmadımı acaba.
Desteğinizi bekliyorum.

GM 5 Plus d cihazımdan Tapatalk kullanılarak gönderildi

halit3 · 26 Kasım 2018

Bu kodu bir dene

kod C5 hücresindeki sayfa ismi ile D5 hücresindeki tarihe göre verileri 6. satıra almaktadır.

Kod:

Sub kapalıverial()

Dim fd As FileDialog
Dim selectedPaths() As String
Dim I As Integer

Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.AllowMultiSelect = True
.FilterIndex = 2
.Title = "Select Excel File(s)"
.InitialFileName = ThisWorkbook.Path
If .Show = -1 Then
ReDim selectedPaths(.SelectedItems.Count - 1)
For I = 0 To .SelectedItems.Count - 1
selectedPaths(I) = .SelectedItems(I + 1)

kap_dos_sütün_no = "A" 'veri alınacak kapalı dosyanın son dolu satırıma ait sutun adı
sonsat = 65000          'Rows.Count - 1
kap_dos_satir_no = 14    'veri alınacak kapalı dosyanın son dolu sütununa ait satır numarası

Kaynak = fd.SelectedItems(I + 1)

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
Klasor = fL.GetParentFolderName(Kaynak)
dosya = fL.GetFileName(Kaynak)

If Right(Klasor, 1) <> "\" Then Klasor = Klasor & "\"

SayfaAdi = Cells(5, 3).Value
m = 5 'yazılacak satır

deg2 = Klasor & "[" & dosya & "]" & SayfaAdi
deg3 = "'" & Klasor & "[" & dosya & "]" & SayfaAdi & "'!R"

yer1 = "LOOKUP(2,1/('" & deg2 & "'!" & kap_dos_satir_no & ":" & kap_dos_satir_no & "<>""""),COLUMN('" & deg2 & "'!" & kap_dos_satir_no & ":" & kap_dos_satir_no & "))"
Cells(1, 4).Value = "=IF(ISERROR(" & yer1 & "),""""," & yer1 & ")"
Cells(1, 4).Value = Cells(1, 4).Value
sut1 = Cells(1, 4).Value ' Kapalı dosyaya ait son dolu sütun sayısı

yer2 = "LOOKUP(2,1/('" & deg2 & "'!" & kap_dos_sütün_no & "1:" & kap_dos_sütün_no & sonsat & "<>""""),ROW('" & deg2 & "'!" & kap_dos_sütün_no & ":" & kap_dos_sütün_no & "))"
Cells(1, 5).Value = "=IF(ISERROR(" & yer2 & "),""""," & yer2 & ")"
Cells(1, 5).Value = Cells(1, 5).Value
sat1 = Cells(1, 5).Value ' Kapalı dosyaya ait son dolu satır sayısı

If Val(sut1) = 0 Or Val(sat1) = 0 Then MsgBox "son dolu satır ve son dolu sütunda değer yok": Exit Sub

For r = 15 To sat1
hucre = ExecuteExcel4Macro(deg3 & r & "C1")

deg1 = Split(hucre, " ")
If UBound(deg1) > 0 Then

deg2 = Split(deg1(0), ".")
If UBound(deg2) > 0 Then
veri = Format(Format(deg2(0), "00") & "." & Format(deg2(1), "00") & "." & Format(deg2(2), "0000"), "dd.mm.yyyy")
If CDate(Cells(m, 4).Value) = CDate(veri) Then

Cells(m, 5).Value = ExecuteExcel4Macro(deg3 & r & "C4")
Cells(m, 6).Value = ExecuteExcel4Macro(deg3 & r & "C5")
Cells(m, 8).Value = ExecuteExcel4Macro(deg3 & r + 1 & "C4")
Cells(m, 9).Value = ExecuteExcel4Macro(deg3 & r + 1 & "C5")
Cells(m, 11).Value = ExecuteExcel4Macro(deg3 & r + 1 & "C8")
Cells(m, 12).Value = ExecuteExcel4Macro(deg3 & r + 1 & "C14")
m = m + 1
End If

End If
End If

Next r


MsgBox "işlem tamam"


Next I
End If
'.Execute     'Open selected files
End With
Set fd = Nothing

End Sub

_GÜRCAN_ · 26 Kasım 2018

halit3' Alıntı:

Bu kodu bir dene

kod C5 hücresindeki sayfa ismi ile D5 hücresindeki tarihe göre verileri 6. satıra almaktadır.

Kod:

Sub kapalıverial()

Dim fd As FileDialog
Dim selectedPaths() As String
Dim I As Integer

Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.AllowMultiSelect = True
.FilterIndex = 2
.Title = "Select Excel File(s)"
.InitialFileName = ThisWorkbook.Path
If .Show = -1 Then
ReDim selectedPaths(.SelectedItems.Count - 1)
For I = 0 To .SelectedItems.Count - 1
selectedPaths(I) = .SelectedItems(I + 1)

kap_dos_sütün_no = "A" 'veri alınacak kapalı dosyanın son dolu satırıma ait sutun adı
sonsat = 65000 'Rows.Count - 1
kap_dos_satir_no = 14 'veri alınacak kapalı dosyanın son dolu sütununa ait satır numarası

Kaynak = fd.SelectedItems(I + 1)

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
Klasor = fL.GetParentFolderName(Kaynak)
dosya = fL.GetFileName(Kaynak)

If Right(Klasor, 1) <> "\" Then Klasor = Klasor & "\"

SayfaAdi = Cells(5, 3).Value
m = 6 'yazılacak satır

deg2 = Klasor & "[" & dosya & "]" & SayfaAdi
deg3 = "'" & Klasor & "[" & dosya & "]" & SayfaAdi & "'!R"

yer1 = "LOOKUP(2,1/('" & deg2 & "'!" & kap_dos_satir_no & ":" & kap_dos_satir_no & "<>""""),COLUMN('" & deg2 & "'!" & kap_dos_satir_no & ":" & kap_dos_satir_no & "))"
Cells(1, 4).Value = "=IF(ISERROR(" & yer1 & "),""""," & yer1 & ")"
Cells(1, 4).Value = Cells(1, 4).Value
sut1 = Cells(1, 4).Value ' Kapalı dosyaya ait son dolu sütun sayısı

yer2 = "LOOKUP(2,1/('" & deg2 & "'!" & kap_dos_sütün_no & "1:" & kap_dos_sütün_no & sonsat & "<>""""),ROW('" & deg2 & "'!" & kap_dos_sütün_no & ":" & kap_dos_sütün_no & "))"
Cells(1, 5).Value = "=IF(ISERROR(" & yer2 & "),""""," & yer2 & ")"
Cells(1, 5).Value = Cells(1, 5).Value
sat1 = Cells(1, 5).Value ' Kapalı dosyaya ait son dolu satır sayısı

If Val(sut1) = 0 Or Val(sat1) = 0 Then MsgBox "son dolu satır ve son dolu sütunda değer yok": Exit Sub

For r = 15 To sat1
hucre = ExecuteExcel4Macro(deg3 & r & "C1")

deg1 = Split(hucre, " ")
If UBound(deg1) > 0 Then

deg2 = Split(deg1(0), ".")
If UBound(deg2) > 0 Then
veri = Format(Format(deg2(0), "00") & "." & Format(deg2(1), "00") & "." & Format(deg2(2), "0000"), "dd.mm.yyyy")
If CDate(Cells(m, 4).Value) = CDate(veri) Then

Cells(m, 5).Value = ExecuteExcel4Macro(deg3 & r & "C4")
Cells(m, 6).Value = ExecuteExcel4Macro(deg3 & r & "C5")
Cells(m, 8).Value = ExecuteExcel4Macro(deg3 & r + 1 & "C4")
Cells(m, 9).Value = ExecuteExcel4Macro(deg3 & r + 1 & "C5")
Cells(m, 11).Value = ExecuteExcel4Macro(deg3 & r + 1 & "C8")
Cells(m, 12).Value = ExecuteExcel4Macro(deg3 & r + 1 & "C14")
m = m + 1
End If

End If
End If

Next r


MsgBox "işlem tamam"


Next I
End If
'.Execute 'Open selected files
End With
Set fd = Nothing

End Sub

Halit3 ustam yarın deneyip sonucunu döneceğim.
Şimdiden teşekkür ederim.
Hayırlı akşamlar dilerim.

GM 5 Plus d cihazımdan Tapatalk kullanılarak gönderildi

_GÜRCAN_ · 27 Kasım 2018

Halit3 ustam göndermiş olduğunuz çozüm makro imiş, benim makro ile aram iyi değil.[emoji20]
Mümkünse formül kullanarak verileri çekmek mümkün olabilir mi.[emoji3525]
Vereceğiniz destek için şimdiden teşekkür ederim.

GM 5 Plus d cihazımdan Tapatalk kullanılarak gönderildi

halit3 · 27 Kasım 2018

Kapalı dosyadan verileri fornülle nasıl alınır bilemem benim çözümüm makro ile

_GÜRCAN_ · 27 Kasım 2018

Halit3 ustam
Ek'te olması gereken tablolar var fakat değerler gelmemekte.
yardımcı olabilirmisiniz.

halit3 · 27 Kasım 2018

ornek dosyalarınız sanayi tüketim sayfasında sayfa isimleri c sutununda böyle gidiyor.
FİRMA_1
FİRMA_2
FİRMA_3
FİRMA_4
FİRMA_5
günlük dosyanızda ise sayfa isimleri
FİRMA_01
FİRMA_02
FİRMA_03
FİRMA_04
FİRMA_05

böyle gidiyor uyumsuzluklar var

halit3 · 27 Kasım 2018

Birde şunu söylüyüm ilk mesajınızda bu kadar veri yoktu dosyanızda keşke en baştan bunları yazsaydınız.

_GÜRCAN_ · 27 Kasım 2018

halit3' Alıntı:
ornek dosyalarınız sanayi tüketim sayfasında sayfa isimleri c sutununda böyle gidiyor.
FİRMA_1
FİRMA_2
FİRMA_3
FİRMA_4
FİRMA_5
günlük dosyanızda ise sayfa isimleri
FİRMA_01
FİRMA_02
FİRMA_03
FİRMA_04
FİRMA_05

böyle gidiyor uyumsuzluklar var

Halit3 ustam 0 eklememişim.

GM 5 Plus d cihazımdan Tapatalk kullanılarak gönderildi

_GÜRCAN_ · 27 Kasım 2018

halit3' Alıntı:
Birde şunu söylüyüm ilk mesajınızda bu kadar veri yoktu dosyanızda keşke en baştan bunları yazsaydınız.

Halit3 ustam örnek formüle göre giderim diye kısaltma yapmıştım ama sonradan hata yaptığımı anladım.[emoji847]

GM 5 Plus d cihazımdan Tapatalk kullanılarak gönderildi

_GÜRCAN_ · 27 Kasım 2018

Halit3 ustam tabloyu düzenledim.

halit3 · 27 Kasım 2018

önceki dosyanıza göre kodları eklediğim dosyayı rar dan çıkartın ve her iki dosya ayn yana olsun sonra SANAYİ TÜKETİM RAPORU dosyasını açın data sayfasındaki komut düğmesine tıklayınız burada yapılan işlem günlük dosyasını açıyor ve bütün sayfalardaki bilgileri kapyalayıp data sayfasına yapıştırıyor.
GÜNLÜK TÜK. sayfasındaki veri al düğmesine tıklayınız.
sonuçları irdeleyiniz.

_GÜRCAN_ · 28 Kasım 2018

halit3' Alıntı:
önceki dosyanıza göre kodları eklediğim dosyayı rar dan çıkartın ve her iki dosya ayn yana olsun sonra SANAYİ TÜKETİM RAPORU dosyasını açın data sayfasındaki komut düğmesine tıklayınız burada yapılan işlem günlük dosyasını açıyor ve bütün sayfalardaki bilgileri kapyalayıp data sayfasına yapıştırıyor.
GÜNLÜK TÜK. sayfasındaki veri al düğmesine tıklayınız.
sonuçları irdeleyiniz.

Halit3 ustam yardımınız için çok teşekkür ederim.

GM 5 Plus d cihazımdan Tapatalk kullanılarak gönderildi

halit3 · 28 Kasım 2018

Teşekkürler iyi çalışmalar

Kapalı Tablodan Değer Getirme..

_GÜRCAN_

Ekli dosyalar

_GÜRCAN_

halit3

Uzman

Ekli dosyalar

_GÜRCAN_

_GÜRCAN_

halit3

Uzman

Ekli dosyalar

_GÜRCAN_

Ekli dosyalar

halit3

Uzman

halit3

Uzman

_GÜRCAN_

_GÜRCAN_

_GÜRCAN_

Ekli dosyalar

halit3

Uzman

Ekli dosyalar

_GÜRCAN_

halit3

Uzman