excel macro ile hücreler arası bilgi aktarıp tabloyu pivota uygun hale getirmek

[uywork]

Arkadaşlar selam,

Excel visual basic ve macroda yeniyim,
Çalıştığım fabrikada üretim sahasında yer alan sensörlerden csv dosyaları halinde datalar topluyorum, bu dataları yorumlayabilmek için pivot grafikleri haline getirmeye çalışıyorum. gün geçtikte gelen sensör sayısı ve data sayısı artmakta olduğundan macro suz yapmak iyice zor hale geldi, fikirlerinizi paylaşırsanız sevinirim.

- ekte 3 adet excel belgesi yer almakta,
- 1 isimli belge aldığım ham datadır, data aldığım sensörün ismi ve hemen altında zamana bağlı data değerler, yer almakta.
- hedefim makro yardımı ile 1 isimli belgeyi, 3 isimli belge haline (pivot hale) getirmek, data aldığım sensör sayısı (point sayısı) zamanla artacak ve her bir sensörden data sayısıda zamanla artacak.
- ben 1 isimli belgeyi, 2 isimli belge haline makro olmadan filtreleme ile kısa zamanda getiriyorum ama asıl zaman alan 3 nolu belge halinde getirebilmek.

* 1 nolu belgeyi makro ile 3 nolu belge haline getirme konusunda fikirlerinizi paylaşırsanız sevinirim, nasıl bir kod yazmalıyım.
* eğer bu çok mümkün olmaz ise en azından 2 den 3 e geçmeliyim makro ile :redface:
* bu arada data gelen nokta sayısının zamanla artacağına, ve noktalara ait datalarında zamanla artacağına dikkatt !! :redface:

 

[Korhan Ayhan]

Selamlar,

Ham datanızın bulunduğu dosyada aşağıdaki makroyu çalıştırıp denermisiniz. Listeleme E-F-G sütunlarına yapılacaktır.

Option Explicit
 
Sub VERİ_DÜZENLE()
    Dim X As Long, BUL As Byte, Y As Byte, Sütun As Byte, AYIR() As String
    
    Application.ScreenUpdating = False
    
    [E:G].ClearContents
    
    For X = 1 To [A65536].End(3).Row
    If Left(Cells(X, 1), 5) = "Point" Then
    BUL = InStr(1, Cells(X, 1), ":") + 3
    Cells(X, 5) = Trim(Mid(Cells(X, 1), BUL, 50))
    End If
    If IsNumeric(Left(Cells(X, 1), 1)) = True Then
    AYIR = Split(Cells(X, 1), " ")
    
    Sütun = 6
    
    For Y = 0 To UBound(AYIR())
    If AYIR(Y) <> "" And AYIR(Y) <> "*F*" And AYIR(Y) <> "-N-" And AYIR(Y) <> "NONE" Then
    If Y <= 2 Then
    Cells(X, Sütun) = IIf(Cells(X, Sütun) = "", AYIR(Y), Cells(X, Sütun) & " " & AYIR(Y))
    Else
    Sütun = Sütun + 1
    Cells(X, Sütun) = AYIR(Y)
    End If
    End If
    Next
    End If
    Next
    
    Columns("E:E").SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Columns("E:E").Copy
    Columns("E:E").PasteSpecial Paste:=xlPasteValues
    Range("A1").Select
    Application.CutCopyMode = False
    [E1] = "SENSÖR"
    [F1] = "TIME"
    [G1] = "DEĞER"
    Range("E1:G1").HorizontalAlignment = xlCenter
    Range("E1:G1").Font.Bold = True
    Columns("E:G").EntireColumn.AutoFit
    For X = [E65536].End(3).Row To 2 Step -1
    If Cells(X, 6) = "" Then Range(Cells(X, 5), Cells(X, 9)).Delete
    Next
    
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[uywork]

sorunsuz olarak çalışmakta teşekkürler,
yapılanları öğrenmeye çalışıyorum