Düşeyara

[bursacem]

Sayın Üstadlar;

ekli dosyada "rnd." çalışma sayfasında ki tabloda vardiya dilimlerin de(08-16,16-24,24/08) hangi tarihte o makinenin kaç randıman çalıştığı yer almaktadır. Buradaki randımanı "veri" çalışma sayfasındaki kesiştiği hücreye nasıl getirebiliriz?(kesişenler Makine No,Tarih ve Vardiya Dilimi)

Örnek olarak birkaç tanesini elle yazdım.

Şimdiden çok teşekkürler

 

[Vedat Özer]

Selamlar,

Ekteki dosyayı inceleyin.
Alternatif çözümler olabilir..

Sub OZET()
    Range("j1:Q65536").ClearContents
        Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
    
    sorgu = "transform SUM(RDN) select Grup_No,Makine_No,Tarih from [veri$] group by Grup_No,Makine_No,Tarih pivot VRD"
    
    Set rs = con.Execute(sorgu)
    Range("J2").CopyFromRecordset rs
    For i = 0 To rs.Fields.Count - 1
        Cells(1, i + 10).Value = Replace(rs.Fields(i).Name, "_", " ")
    Next i
    
End Sub

 

[bursacem]

Hocam ilginiz için teşekkürler.

Fakat ben "rnd." sayfasında ki verilerin, "veri" sayfasında ki ilgili yerlere gelmesini istiyorum.

Örneğin ; "rnd"sayfasında yer alan H001 numaralı makinenin 08-16 Vardiya diliminde ve 15 kasım tarihine denk gelen sayının(87.7)

"veri" sayfasında ki H001 15 Kasım ve 08-16 vardiya dilimine gelenin karşılığına getirmek istiyorum.

Buradaki amaç personelin randımanını alabilmek için

 

[asimavi50]

Değerli kardeşim, normal düşeyara formülü ile yapılamaz çünkü aynı kodlar var... Alternatif olarak ekteki dosya işinizi görebilir.

 

[Vedat Özer]

Selamlar,

Tam tersini yapmışım
Alternatif olarak aşağıdaki kodları kullanabilirsiniz.

Option Explicit
Sub tabloo()
Dim a(), b(), S1 As Worksheet, S2 As Worksheet
Dim Say  As Long, X  As Long, Y As Long
Set S1 = Sheets("rnd."): Set S2 = Sheets("veri")
a = S1.Range("A1:f" & S1.Cells(Rows.Count, 1).End(3).Row).Value
ReDim b(1 To UBound(a) * 3, 1 To 5)
For Y = 3 To 5
    For X = 2 To UBound(a)
        Say = Say + 1
        b(Say, 1) = a(X, 1)
        b(Say, 2) = a(X, 2)
        b(Say, 3) = a(1, Y)
        b(Say, 4) = a(X, Y)
        b(Say, 5) = a(X, 6)
        
    Next X
Next Y
Application.ScreenUpdating = False
    S2.Range("A2:E" & Rows.Count).ClearContents
    If Say > 0 Then
        S2.[A2].Resize(Say, 5) = b
    End If
Application.ScreenUpdating = True
S2.Select
MsgBox "İşlem tamam...", vbInformation, Environ("Username")
End Sub