Başka bir excel kitabından değer alma

sinful · 10 Temmuz 2007

Arkadaşlar, Çalıştığım yerde herkez kendi konusuyla ilgili çalışmalarını farklı excel çalışma kitaplarında tutuyorlar.Benim amacım bu çalışma kitaplarındaki verileri bir excel tablosunda toparlamak. Bu mümkünmüdür yani başka br excel çalışmasındaki çeşitli hücrelerdeki değerleri bir excel kitabında Bağ Yapıştır türü toparlayıp onlar bu değerleri değiştirdikçe özet çalışma kitabınında otomatik güncellenmesi mümkünmüdür?

sinful · 14 Temmuz 2007

Başka bir excel dökümanından veri alma

Arkadaşlar, Çalıştığım yerde herkez kendi konusuyla ilgili çalışmalarını farklı excel çalışma kitaplarında tutuyorlar.Benim amacım bu çalışma kitaplarındaki verileri bir excel tablosunda toparlamak. Bu mümkünmüdür yani başka br excel çalışmasındaki çeşitli hücrelerdeki değerleri bir excel kitabında Bağ Yapıştır türü toparlayıp onlar bu değerleri değiştirdikçe özet çalışma kitabınında otomatik güncellenmesi mümkünmüdür?:roll:

hakkım · 14 Temmuz 2007

bu konuda bilgi verirseniz makbule geçer ado veya dao ilemi olcak onunla olursada mesela normal veriyi çekmek istediğimiz dosyayla aynıyerde ols olmazmı mesela forumdaki ado lu dosyalrı bktım veri dosyası için kesin yol yazıyolar bunun yerine bi kodla veriyi çekmek istediğimiz kodla veri dosyası aynı yerde olsa yeni veriyi çekmek istediğimiz dosya nerdeyse veri dosyasınıda orada arasa olmazmı

filizcandan · 18 Temmuz 2007

sinful' Alıntı:
Arkadaşlar, Çalıştığım yerde herkez kendi konusuyla ilgili çalışmalarını farklı excel çalışma kitaplarında tutuyorlar.Benim amacım bu çalışma kitaplarındaki verileri bir excel tablosunda toparlamak. Bu mümkünmüdür yani başka br excel çalışmasındaki çeşitli hücrelerdeki değerleri bir excel kitabında Bağ Yapıştır türü toparlayıp onlar bu değerleri değiştirdikçe özet çalışma kitabınında otomatik güncellenmesi mümkünmüdür?:roll:

Yapmak istediğin mümkündür tabiki fakat yapmaka istediğinizi doğru anlamamız için örnek bir dosya yapıp gönderirseniz daha çabuk yardımcı oluruz.

filizcandan · 18 Temmuz 2007

evet yapmak istediğiniz mümkündür. Fakat yapmak istediğinizi örnek bir tablo üzerinde gösterirseniz düzeltmelri yapıp size gönderirim.

ismailuguz · 29 Temmuz 2007

merhaba arkadaşlar ekteki klasörde arama ve kayıt adlarında iki dosyam var.
kayıt dosyasında kişilere ait bilgiler kayıtlı.
arama dosyasını açınca açılan formda arama yapınca kişiye üst tarafta bulunan checkbox'ların kişinin kayıt dosyasındaki kaydına göre aktif veya pasif olmasını istiyorum.
mesela mehmet balta'yı arayınca kayıt dosyasında mehmet baltanın ismine karşılık gelen O stununda x işareti varsa formdaki bireysel checkbox'ı aktif yoksa pasif olsun.Aynı şekilde P ve Q sutunlarında x işareti varsa grup ve ftr bölümleri de oradaki bilgiye göre aktif ve pasif olsun istiyorum.
teşekkürler

ismailuguz · 30 Temmuz 2007

yardım !!!

ismailuguz · 31 Temmuz 2007

ismailuguz' Alıntı:
merhaba arkadaşlar ekteki klasörde arama ve kayıt adlarında iki dosyam var.
kayıt dosyasında kişilere ait bilgiler kayıtlı.
arama dosyasını açınca açılan formda arama yapınca kişiye üst tarafta bulunan checkbox'ların kişinin kayıt dosyasındaki kaydına göre aktif veya pasif olmasını istiyorum.
mesela mehmet balta'yı arayınca kayıt dosyasında mehmet baltanın ismine karşılık gelen O stununda x işareti varsa formdaki bireysel checkbox'ı aktif yoksa pasif olsun.Aynı şekilde P ve Q sutunlarında x işareti varsa grup ve ftr bölümleri de oradaki bilgiye göre aktif ve pasif olsun istiyorum.
teşekkürler

yardımlarınızı bekliyorum arkadaşlar.

Orion1 · 31 Temmuz 2007

ismailuguz' Alıntı:
yardımlarınızı bekliyorum arkadaşlar.

Merhaba.
Keşke yeni bir topic açıp sorunuzu oray sorsaydınız.!Öyle sanıyorum ki dağa hızlı cevap alabilecektiniz.!
Kolay gelsin.

Orion1 · 31 Temmuz 2007

Merhaba.
Ekli dosyayı inceleyiniz.
Yalnız her 2 dosyanında açık olması gerekiyor.

Kod:

Private Sub CommandButton1_Click()
Dim syf As Worksheet, say As Double, isim As String, s As Long
CheckBox1.Value = False
CheckBox1.Enabled = True
CheckBox2.Value = False
CheckBox2.Enabled = True
CheckBox3.Value = False
CheckBox3.Enabled = True
On Error Resume Next
Set s1 = Workbooks("KAYIT.xls").Sheets("KAYIT")
For s = 2 To s1.Cells(65536, "A").End(xlUp).Row
    isim = s1.Cells(s, "B").Value & " " & s1.Cells(s, "C").Value
    If UCase(Replace(Replace(isim, "i", "İ"), "ı", "I")) = _
    UCase(Replace(Replace(TextBox1.Value, "i", "İ"), "ı", "I")) Then
        If UCase(Replace(s1.Cells(s, "O").Value, "x", "X")) = "X" Then
        CheckBox1.Enabled = False
        Else
        CheckBox1.Enabled = True
        End If
        If UCase(Replace(s1.Cells(s, "P").Value, "x", "X")) = "X" Then
        CheckBox2.Enabled = False
        Else
        CheckBox2.Enabled = True
        End If
        If UCase(Replace(s1.Cells(s, "Q").Value, "x", "X")) = "X" Then
        CheckBox3.Enabled = False
        Else
        CheckBox3.Enabled = True
        End If
      Exit For
      End If
Next s
Set s1 = Nothing
ListBox1.Clear
Dim FirstMatch As String, strVal As String, MyMsg As String
Dim MyData As Variant
sat = 0
If Len(TextBox1) >= 1 Then
Set MyData = Range("a4:ı34").Find(TextBox1)
If Not MyData Is Nothing Then
FirstMatch = MyData.Address
Do
ListBox1.AddItem
ListBox1.Column(0, sat) = MyData.Address
ListBox1.Column(1, sat) = MyData
If IsDate(Cells(MyData.Row, "A")) Then
    ListBox1.Column(2, sat) = Format(Cells(MyData.Row, "A").Value, "dd.mm.yyyy")
    Else
    ListBox1.Column(2, sat) = Cells(MyData.Row, "A").Value
End If
ListBox1.Column(3, sat) = Cells(3, MyData.Column).Value
sat = sat + 1
Set MyData = Range("a4:ı34").FindNext(MyData)
Loop While Not MyData Is Nothing And MyData.Address <> FirstMatch
End If
Else
MsgBox "Aranılacak değeri girin..."
Exit Sub
End If
Set MyData = Nothing
TextBox1.Text = ""
TextBox2.Text = ListBox1.ListCount
TextBox4.Text = Val(TextBox2.Value) + Val(TextBox3.Value)
End Sub

ismailuguz · 31 Temmuz 2007

teşekkürler sayın orion2.Kayıt dosyası kapalıyken yapamazmıyız.

Orion1 · 31 Temmuz 2007

ismailuguz' Alıntı:
teşekkürler sayın orion2.Kayıt dosyası kapalıyken yapamazmıyız.

Sanırım exel4 makrosu ile yapılabilir.
Dağa önce excel4 makrosu ile bir çalışma yapmadım.Ama bir deneyeyim bakalım, olursa bende bu konuyu işleme sokmuş olurum.

Orion1 · 31 Temmuz 2007

ismailuguz' Alıntı:
teşekkürler sayın orion2.Kayıt dosyası kapalıyken yapamazmıyız.

İşte size excel4 makrosu ile hazırlanmış kapalı dosyadan sorgulama yapan dosya.
Bende bu konuyu böylece öğrenmiş oldum.Uygulayarak.
Yalnız dikkat edilmesi gereken konu ben kayıt.xls dosyasını C:\ kök dizininde iken çalıştırdım.Siz kayıt xls dosyası hani dizinde ise benim kırmızı ile işaretlediğim yerlere sizin dizininizi yazınız.
Ekli dosyayı inceleyiniz.

Kod:

Private Sub CommandButton1_Click()
Dim syf As Worksheet, say As Double, isim As String, s As Long
CheckBox1.Value = False
CheckBox1.Enabled = True
CheckBox2.Value = False
CheckBox2.Enabled = True
CheckBox3.Value = False
CheckBox3.Enabled = True
On Error Resume Next
sonsat = ExecuteExcel4Macro("COUNTA([COLOR="Red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!C1)")
For s = 2 To sonsat
    isim = ExecuteExcel4Macro("[COLOR="red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!R" & s & "C2") & " " _
    & ExecuteExcel4Macro("[COLOR="red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!R" & s & "C3")
    If UCase(Replace(Replace(isim, "i", "İ"), "ı", "I")) = _
    UCase(Replace(Replace(TextBox1.Value, "i", "İ"), "ı", "I")) Then
        x1 = ExecuteExcel4Macro("[COLOR="red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!R" & s & "C15")
        x2 = ExecuteExcel4Macro("[COLOR="red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!R" & s & "C16")
        x3 = ExecuteExcel4Macro("[COLOR="red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!R" & s & "C17")
        If UCase(Replace(x1, "x", "X")) = "X" Then
        CheckBox1.Enabled = False
        Else
        CheckBox1.Enabled = True
        End If
        If UCase(Replace(x2, "x", "X")) = "X" Then
        CheckBox2.Enabled = False
        Else
        CheckBox2.Enabled = True
        End If
        If UCase(Replace(x3, "x", "X")) = "X" Then
        CheckBox3.Enabled = False
        Else
        CheckBox3.Enabled = True
        End If
      Exit For
      End If
Next s
ListBox1.Clear
Dim FirstMatch As String, strVal As String, MyMsg As String
Dim MyData As Variant
sat = 0
If Len(TextBox1) >= 1 Then
Set MyData = Range("a4:ı34").Find(TextBox1)
If Not MyData Is Nothing Then
FirstMatch = MyData.Address
Do
ListBox1.AddItem
ListBox1.Column(0, sat) = MyData.Address
ListBox1.Column(1, sat) = MyData
If IsDate(Cells(MyData.Row, "A")) Then
    ListBox1.Column(2, sat) = Format(Cells(MyData.Row, "A").Value, "dd.mm.yyyy")
    Else
    ListBox1.Column(2, sat) = Cells(MyData.Row, "A").Value
End If
ListBox1.Column(3, sat) = Cells(3, MyData.Column).Value
sat = sat + 1
Set MyData = Range("a4:ı34").FindNext(MyData)
Loop While Not MyData Is Nothing And MyData.Address <> FirstMatch
End If
Else
MsgBox "Aranılacak değeri girin..."
Exit Sub
End If
Set MyData = Nothing
TextBox1.Text = ""
TextBox2.Text = ListBox1.ListCount
TextBox4.Text = Val(TextBox2.Value) + Val(TextBox3.Value)
End Sub

ismailuguz · 31 Temmuz 2007

teşekkürler sayın orion2 sayenizde programı tamamladım ama ben biraz karıştırdım beceremedim.Ekteki dosyayada kodlar biraz değişik rica etsem oraya yerleştirebilirmisiniz.
çok teşekkürler.

Orion1 · 1 Ağustos 2007

ismailuguz' Alıntı:
teşekkürler sayın orion2 sayenizde programı tamamladım ama ben biraz karıştırdım beceremedim.Ekteki dosyayada kodlar biraz değişik rica etsem oraya yerleştirebilirmisiniz.
çok teşekkürler.

Merhaba.
Ekli dosyayı istediğiniz şekilde düzenledim.
Yalnız Kayıt dosyası C:\ kök dizininde onun yolunu siz kendinze göre değiştirin .Ben kırmızı ile işaretledim.

Kod:

Private Sub CommandButton1_Click()
Dim syf As Worksheet, saygr, sayftr As Double, isim As String
Dim sonsat As Long, s As Long, x1 As String, x2 As String, x3 As String
CheckBox1.Value = False
CheckBox1.Enabled = True
CheckBox2.Value = False
CheckBox2.Enabled = True
CheckBox3.Value = False
CheckBox3.Enabled = True
On Error Resume Next
sonsat = ExecuteExcel4Macro("COUNTA([COLOR="Red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!C1)")
For s = 2 To sonsat
    isim = ExecuteExcel4Macro("[COLOR="red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!R" & s & "C2") & " " _
    & ExecuteExcel4Macro("[COLOR="red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!R" & s & "C3")
    If UCase(Replace(Replace(isim, "i", "İ"), "ı", "I")) = _
    UCase(Replace(Replace(TextBox1.Value, "i", "İ"), "ı", "I")) Then
        x1 = ExecuteExcel4Macro("[COLOR="red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!R" & s & "C15")
        x2 = ExecuteExcel4Macro("[COLOR="red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!R" & s & "C16")
        x3 = ExecuteExcel4Macro("[COLOR="red"]'C:\[/COLOR][KAYIT.xls]KAYIT'!R" & s & "C17")
        If UCase(Replace(x1, "x", "X")) = "X" Then
        CheckBox1.Enabled = False
        Else
        CheckBox1.Enabled = True
        End If
        If UCase(Replace(x2, "x", "X")) = "X" Then
        CheckBox2.Enabled = False
        Else
        CheckBox2.Enabled = True
        End If
        If UCase(Replace(x3, "x", "X")) = "X" Then
        CheckBox3.Enabled = False
        Else
        CheckBox3.Enabled = True
        End If
      Exit For
      End If
Next s
ListBox1.Clear
TextBox3.Value = "": TextBox5.Value = ""
For Each syf In Worksheets
    If Right(syf.Name, 4) = "(GR)" Then
        saygr = saygr + WorksheetFunction.CountIf(Sheets(syf.Name).Range("A1:e65536"), TextBox1.Value)
    End If
    If Right(syf.Name, 5) = "(FTR)" Then
        sayftr = sayftr + WorksheetFunction.CountIf(Sheets(syf.Name).Range("A1:IV65536"), TextBox1.Value)
    End If
Next
TextBox5.Value = saygr: TextBox3.Value = sayftr
Dim FirstMatch As String, strVal As String, MyMsg As String
Dim MyData As Variant
sat = 0
If Len(TextBox1) >= 1 Then
Set MyData = Range("a4:ı34").Find(TextBox1)
If Not MyData Is Nothing Then
FirstMatch = MyData.Address
Do
ListBox1.AddItem
ListBox1.Column(0, sat) = MyData.Address
ListBox1.Column(1, sat) = MyData
If IsDate(Cells(MyData.Row, "A")) Then
    ListBox1.Column(2, sat) = Format(Cells(MyData.Row, "A").Value, "dd.mm.yyyy")
    Else
    ListBox1.Column(2, sat) = Cells(MyData.Row, "A").Value
End If
ListBox1.Column(3, sat) = Cells(3, MyData.Column).Value
sat = sat + 1
Set MyData = Range("a4:ı34").FindNext(MyData)
Loop While Not MyData Is Nothing And MyData.Address <> FirstMatch
End If
Else
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox2.BackColor = vbWhite
TextBox3.BackColor = vbWhite
TextBox4.BackColor = vbWhite
TextBox5.BackColor = vbWhite
Label6.Caption = ""

Msg = CreateObject("WScript.Shell").Popup("ARANACAK BİR DEĞER GİRİN", 1, "UYARI")

Exit Sub
End If
Set MyData = Nothing
TextBox1.Text = ""

TextBox2.Text = ListBox1.ListCount
TextBox4.Text = Val(TextBox2.Value) + Val(TextBox3.Value)

If CheckBox1.Value = False And Val(TextBox2.Text) > 0 Then
TextBox2.BackColor = vbYellow
Else
TextBox2.BackColor = vbWhite
End If
If CheckBox2.Value = False And Val(TextBox5.Text) > 0 Then
TextBox5.BackColor = vbYellow
Else
TextBox5.BackColor = vbWhite
End If
If CheckBox3.Value = False And Val(TextBox3.Text) > 0 Then
TextBox3.BackColor = vbYellow
Else
TextBox3.BackColor = vbWhite
End If

If TextBox2.BackColor = vbYellow Or TextBox3.BackColor = vbYellow Or TextBox5.BackColor = vbYellow Then
Label6.ForeColor = vbRed
Label6.Caption = "bu öğrencide bir sorun var"
Else
Label6.Caption = ""
End If

End Sub

ismailuguz · 1 Ağustos 2007

teşekkürler sayın orion2
size iyi çalışmalar

Orion1 · 1 Ağustos 2007

ismailuguz' Alıntı:
teşekkürler sayın orion2
size iyi çalışmalar

Arama dosyasındaki userform açılırken geç açılıyor.
Sebebi siz ftr ve gr lerde aranılan şahıs isminin hangi kolonda olduğunu söylemediniz bende bütün sayfada saydırdım.
Eğer belli bir kolonda saydırma yapılırsa userform dağa çabuk açılacaktır.
Siz onu söylerseniz ben kodları ona göre düzenlerim.

Ve böylece userform dağa çabuk açılır.

Başka bir excel kitabından değer alma

sinful

Banned

sinful

Banned

hakkım

filizcandan

filizcandan

ismailuguz

ismailuguz

ismailuguz

Orion1

Uzman

Orion1

Uzman

ismailuguz

Orion1

Uzman

Orion1

Uzman

ismailuguz

Orion1

Uzman

ismailuguz

Orion1

Uzman