• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile Excel Toplam İşlemi Yardım

muhammethezer

muhammethezer

Katılım
12 Şubat 2006
Mesajlar
411
Excel Vers. ve Dili
Office 365
Merhaba Değerli Hocam,
Ekli Excel dosyasında takıldığım bir nokta var.
Hazırlamaya çalıştığım proje içerisinde bir adet “Ana_Veriler” isimli Excel dosyası, bu dosyanın içerisinde bir adet “Haftalık_Uretim_Raporu” isimli Excel sayfası bulunmaktadır. UserForm üzerinde ComboBox1 ile Klasör içerisinden Dosyaları; ComboBox2 de ise Dosya içerisindeki sayfa isimlerini alabiliyorum.

Yapmak istediğim işlem kısaca;
“Ana_Veriler”-"Haftalık_Uretim_Raporu" sayfası üzerinde Açıklama Notu ekli olan hücrelere diğer dosyaların "Genel Sayfası C:C kolonunu toplam olarak getirmek.

Birde ComboBox1 üzerinde klsör içerisindeki dosyanın yolu değilde sadece Klasör ismini getirebilir miyiz?

Yardımlarınız için teşekkür ederim.


http://s7.dosya.tc/server13/92desw/ExcelWeb_TR.rar.html
 
Merhaba
Ek dosyadaki gibi deneyiniz.
https://we.tl/t-s8WWskLAve
veya
http://s7.dosya.tc/server13/blb7b1/ExcelWeb_TR2.zip.html
"Combobox2" kodları silindi, kodlar yeni eklenen "Combobox3" e yazıldı
Kod: 
Private Sub ComboBox3_Change()
If ComboBox2.Value = "" Or ComboBox1.Value = "" Or ComboBox3.Value = "" Then Exit Sub
Set s1 = Sheets("Haftalık_Uretim_Raporu")
x = s1.Cells(Rows.Count, "B").End(3).Row
Set ara = s1.Range("B2:B" & x).Find(ComboBox3.Value)
If ara Is Nothing Then MsgBox "Kayıt satırı bulunamadı": Exit Sub
dosya = ComboBox1.Value & "\" & Dir(ComboBox1.Value & "\" & ComboBox2.Value & "*.*", vbDirectory)
Set s1 = ThisWorkbook.Sheets("Haftalık_Uretim_Raporu")
Set con = CreateObject("Adodb.Connection")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dosya & ";Extended Properties = ""Excel 12.0 Macro;HDR=NO"";"
rc = "SELECT sum(F3) FROM [Genel$]"
Set r = con.Execute(rc)
s1.Range("C" & ara.Row + 1).CopyFromRecordset r
con.Close
Set con = Nothing: Set r = Nothing
End Sub
 
Plint Hocam, Ellerinize sağlık. Ancak, istediğim tam olarak anlatamadım galiba.
#1. Sorumda isteğimi eksik olarak belirtmişim.

Yeni klasör içerisinde 2019_A_Verileri, 2019_B_Verileri, 2019_C_Verileri, 2019_D_Verileri, 2019_E_Verileri şeklinde 10 adet Excel dosyası bulunmaktadır.
Her bir dosyanın içerisinde Genel isimli bir sayfa bulunmaktadır. Bu sayfaların B:B kolonunda Hafta şeklinde (1.Hafta, 2:Hafta) 52 Haftalık Üretim verileri bulunmaktadır. UserForm üzerinden yapacağım seçim ile Haftalık_Uretim_Raporu sayfasının C6 Hücresine "2019_Izgara_Verileri - Genel!C:C" kolonunu toplamı; C8 Hücresine "2019_Sivama_Exmet_Verileri - Genel!C:C" kolonunu toplamı; C10 Hücresine "2019_Sivama_Gravity_Verileri - Genel!C:C" kolonunu toplamı şekline haftalık üretim toplamlarını getirmek istiyorum.

Eksik bilgi için sizlerden özür diliyorum. Yardımlarınız için teşekkür ederim.

http://s7.dosya.tc/server13/1oj6bp/ExcelWeb_TR2.rar.html
 
Merhaba
"anadosya" adlı dosyada; diğer dosyadan alınacak toplamın;
mesela "ızgara" yazan hücrenin alt hücre adresinin nasıl tarif edileceği belirsiz (veya o bölümü ben anlayamadım)
"B5" hücresine "ızgara" yerine toplamı alınacak dosyanın adı veya ilgili dosyanın birinci sayfa adı ("2019_ızgara_verileri") yazılarak kodların
sütunda bu adı arayarak alt hücreye yazması sağlanabilir.
Ama ben sırayla seçerim derseniz ek dosyadaki gibi yapabiliriz.
Ek dosyadaki örnek kod; "combobox2" den seçim yaptıkça toplamı "c" sütununda ki ilk boş hücreye yazacaktır.
https://we.tl/t-x5JNj0wEzu
 
"Combobox2" kodları aşağıda;
https://hizliresim.com/DY7l1v
Kod: 
Private Sub ComboBox2_Change()
Dim s1 As Worksheet
Dim x As Long, n As Long, ara As Long, dosya As String
Dim con, r
If ComboBox2.Value = "" Or ComboBox1.Value = "" Then Exit Sub
Set s1 = Sheets("Haftalık_Uretim_Raporu")
x = s1.Cells(Rows.Count, "B").End(3).Row
For n = 5 To x + 1
If Trim(s1.Cells(n, "B")) = "" And Trim(s1.Cells(n, "C")) = "" Then ara = n: Exit For
Next
dosya = ComboBox1.Value & "\" & Dir(ComboBox1.Value & "\" & ComboBox2.Value & "*.*", vbDirectory)
Set s1 = ThisWorkbook.Sheets("Haftalık_Uretim_Raporu")
Set con = CreateObject("Adodb.Connection")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dosya & ";Extended Properties = ""Excel 12.0 Macro;HDR=NO"";"
rc = "SELECT sum(F3) FROM [Genel$]"
Set r = con.Execute(rc)
s1.Range("C" & ara).NumberFormat = "#,##0.00"
s1.Range("C" & ara).CopyFromRecordset r
ComboBox2.Value = ""
con.Close
Set con = Nothing: Set r = Nothing
End Sub
 
Son düzenleme:
Plint Hocam, Mantık sizin yaptığınız gibi, Ancak ben tümünü tek bir tıklama ile getirmek istiyorum. Ayrıca bir UserForm tasarladım. Form üzerinde TabStrip bulunmakta. Bu tablo Referans sayfasından Menü isimlerini alıyor. Bu isimlere sizin yaptığınız gibi tek tek veriler gelebilir. Ancak, Tümü isimli butona tıkladığımda tüm verilerin sayfadaki yerlerini almasını sağlamak istiyorum. Yardımlarınız için Teşekkür ederim.
Örnek dosyayı ekledim.

http://s2.dosya.tc/server6/lvarf1/ExcelWeb_TR2.rar.html
 
Merhaba
Ek dosyadaki gibi referanslar tablosuna dosya adları tam olarak yazılarak çözüm bulunabilir.
http://s7.dosya.tc/server13/8w3qul/deneme.zip.html
veya
https://we.tl/t-Su7yPjodjD

Kod: 
Private Sub TabStrip1_Click(ByVal Index As Long)
If ComboBox1.Value = "" Then Exit Sub
Dim s1 As Worksheet
Dim x As Long, ara As Range, dosya As String, j As Long
Dim tpl As Double, t As Long, dsy As String, yol As String
Dim deg As String, deg1 As String, deg2 As String
Set s1 = Sheets("Haftalık_Uretim_Raporu")
If InStr(1, Me.TabStrip1.SelectedItem.Caption, "Tümü", vdtextcompare) = 1 Then
j = TabStrip1.Tabs.Count
Else
j = 1
deg = Me.TabStrip1.SelectedItem.Caption
End If
Set con = CreateObject("Adodb.Connection")

Set rs = CreateObject("adodb.recordset")
Set s1 = ThisWorkbook.Sheets("Haftalık_Uretim_Raporu")
    For i = 1 To j
If InStr(1, TabStrip1.Tabs(i - 1).Caption, "Tümü", vdtextcompare) = 1 Then Exit Sub
If deg = Empty Then deg = TabStrip1.Tabs(i - 1).Caption
deg1 = Trim(Split(deg, " - ")(0))
deg2 = Trim(Split(deg, " - ")(1))
x = s1.Cells(Rows.Count, "B").End(3).Row
s1.Range("B2:B" & x).Replace Chr(10), ""
Set ara = s1.Range("B2:B" & x).Find(deg2)
If ara Is Nothing Then MsgBox deg2 & " Kayıt satırı bulunamadı": GoTo 10
If Dir(ComboBox1.Value & "\" & deg1 & "*.*", vbDirectory) = "" Then
MsgBox deg1 & " " & deg2 & " Dosyası bulunamadı"
GoTo 10
End If
yol = ComboBox1.Value & "\"
dsy = Dir(ComboBox1.Value & "\" & deg1 & "*.*", vbDirectory)
dosya = yol & dsy

con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dosya & ";Extended Properties = ""Excel 12.0 Macro;HDR=NO"";"
rs.Open "SELECT * FROM [Genel$C1:C100]", con
On Error Resume Next
    While Not rs.EOF
    For t = 0 To rs.Fields.Count - 1
   If IsNumeric(CDbl(rs.Fields.Item(0))) = True Then _
  tpl = tpl + CDbl(rs.Fields.Item(0))
        Next
        rs.MoveNext
     Wend
s1.Cells(ara.Row + 1, "C") = tpl
con.Close: rs.Close
10:
deg = Empty
tpl = 0
     Next i

End Sub
 
Son düzenleme:
Harikasınız PLİNT Hocam Ellerinize ve Emeğinize sağlık. Teşekkür ederim.
 
Merhaba Değerli Hocalarım,
Sizden bir ricam olacaktı? Son eklediğiniz dosya üzerinde, Bazı eklemeler yapmak istiyorum. Yardımcı olabilir misiniz?


1-Hücreler içerisinde bazı formül hesaplamaları bulunmakta. Örnek "U6 Hücresinde =EĞERHATA(C6/(BN6*32*60);0)" gibi. Bu formülleri Makro ile yapmak. ComboBox3 den yaptığım seçimle TextBoxlara “Haftalık_Uretim_Raporu” sayfasından formüllü hücreleri Makro ile getirmek istiyorum.

2-ComboBox1 den yaptığım seçimde sadece Klasör isminin gelmesi.

Dosyam ektedir.
http://s2.dosya.tc/server6/550ugv/Uretim_Veriler.rar.html
 
Ek dosyayı deneyin
https://we.tl/t-F2aYexKXao
Formüllerin yerine veri alan kodlar "Haftalık üretim raporu" sayfasının; kod penceresinde
"ızgara" ve "sıvama(exmet) satırları için olanları yaptım, aynı mantıkla alt satırlara devam ettirirsiniz

Bilirsiniz mantığı ;
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$6" Then
[BJ6] = ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\VeriTabani\[" & Trim([T2].Value) & "]Genel'!R" & [I2].Value + 2 & "C7")

Userform -"TabStrip1" ile "ızgara" sekmesi seçildiğinde ilgili dosyadan toplamı "c6" hücresine yazar kod çalışır.
[BJ6] daki formüle göre (örnek dosyada üst hücredeki başlığa uymuyor gibi ama)
"[T2].value" dosyası "genel" sayfası "[I2]" value +2 'nci satırı column7 verisini getirir

"Combobox1" deki yol yerine sadece klasör adı yazılacağı için "TabStrip1_Click" altında dosya yolu kodlarına ek yapıldı


Sayfadan değer alınacak hücreler ve formdaki "textbox" lar döngüyle veri aldırılacak bir sıralamada değil; karışık görünüyor
Aşağıdaki gibi tek tek yazmak gerek

Private Sub ComboBox3_Change()
For Each j In Me.Controls 'Textboxları temizle
If TypeName(j) = "TextBox" Then j.Value = ""
Next

Textbox1=[U6].value
Textbox2=
'...
'...

End Sub
 
Merhaba Hocam,
Haftalık_Uretim_Raporu sayfasında B1 hücresinde "veri alınacak klasör seçiniz.", B2 hücresinde "klasöre ait istif no seçiniz." ve B3 hücresinde "Ay Seçimi Yap" şeklinde bilgiler var. Bunları nasıl kullanacağım?

Bir de Hocam,
[BJ6] = ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\VeriTabani\[" & Trim([T2].Value) & "]Genel'!R" & [I2].Value + 2 & "C7")

Bu kod satırında "C7" referansı nereden aldınız?
 
Son düzenleme:
C7 = Column 7 anlamındadır.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst