kapalı dosyadan veri alma hk.

[Orion1]

3 Excel Kayıt dosyasında Skor sonuçlar Asya Sonuçlar kısmında da 2 mesala 1.5 üst maçlarında ok yazarsa Sayfa 2 de sonuçlar kısmına Sayfa1 deki A,B,C,D ve E Sütunlarındaki ona karşılık gelen oranlar gelsin istiyorum. bu koşulu halledebilir miyiz?

Sadece skor sonuçlar ve asya sonuçlaramı bakılacak.Tüpçü sonuçlara bakılmayacakmı?

 

[uKiGS]

3 sonuçta bakılırsa daha iyi olur. ama 2 sonuçta işimi görür.

 

[Orion1]

Ne yazılacak?adedimi yazılacak?

 

[uKiGS]

3 sonuçta da OK yazıyorsa OK , SKOR ve Asya da OK yazıyorsa sadece AS yazılırsa sevinirim. Öteki koşullar boş kalsada sorun değil

 

[Orion1]

Tüpçü sonuçlara bakılmayacakmı?

 

[uKiGS]

Ona da bakılacak Skor Asya ve Tüpçü de OK varsa OK sadece Skor ve ASya da varsa AS yazsın istiyorum. Olabilir mi?

 

[Orion1]

Sadece Tüpçü ve asyada varsa ne yazılacak?

 

[uKiGS]

hiç bir şey yazmayacak.

 

[Orion1]

Uğraşıyorum.
Geç oldu.
Çalışmaya yarın devam edelim.
İyi geceler.

 

[uKiGS]

Çok teşekkür ederim. Hakkınızı helal edin.

İyi geceler.

 

[Orion1]

Dosyanzı ektedir.

Sub sonuclar_59()
Dim sh As Worksheet, sut As Byte, i As Long, sonsat As Long
Dim j As Byte, adr As String, alan As Range, var As Boolean
Set sh = Sheets("Sayfa1")
Sheets("Sayfa2").Select
Range("A3:M" & Rows.Count).ClearContents
Application.ScreenUpdating = False
sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
sat = 3
For i = 3 To sonsat
    sut = 6
    For j = 6 To 13
        adr = sh.Range(sh.Cells(i, j).Address & "," & sh.Cells(i, j + 8).Address).Address
        Set alan = sh.Range(adr)
        If hesap(alan) = 2 Then
            Cells(sat, sut) = "AS"
            var = True
        End If
        sut = sut + 1
    Next j
    sut = 6
    For j = 6 To 13
        adr = sh.Range(sh.Cells(i, j).Address & "," & sh.Cells(i, j + 8).Address & "," & sh.Cells(i, j + 16).Address).Address
        Set alan = sh.Range(adr)
        If hesap(alan) = 3 Then
            Cells(sat, sut) = "OK"
            var = True
        End If
        sut = sut + 1
    Next j
    If var = True Then
        Cells(sat, "A").Value = sh.Cells(i, "A").Value
        Cells(sat, "B").Value = sh.Cells(i, "B").Value
        Cells(sat, "C").Value = sh.Cells(i, "C").Value
        Cells(sat, "D").Value = sh.Cells(i, "D").Value
        Cells(sat, "E").Value = sh.Cells(i, "E").Value
        sat = sat + 1
        var = False
    End If
Next i
        
End Sub

 

[uKiGS]

Çok teşekkür ederim emekleriniz için. resmen Mükemmel olmuş.

 

[Orion1]

Rica ederim.
İyi çalışmalar.

 

[hafasepa]

ortak ağdan bir dosya almak istiyorum adresi \\1**.15.**.10\Dosyalar\Belgeler\Sevkiyat\detayli_liste.xlsx şeklinde güncelliyorumm ama benim bilgisayarımdan dosya aramaya çalışıyor.