Zeitbasierte vorschau einer eingefügtenTabelle im Dashboard
#1
Hallo VBA Forum,
Ich habe in Excel ein Dashboard erstellt!
Nun würde ich gerne aus einer externen .xls die täglich per mail kommt eine art vorschau in meinem Dashboard erstellen,
allerdings nur die 10 aktuellsten einträge.In der datei TeamA-23.11.2019.xls ist jeder eintrag mit einer uhrzeit versehen.
ex: eintrag
10:05 KL 758 Thomas Sublieferung
10:07 SB 847 Erik Einkauf
10:16 PL 655 Frank Dichtungsring
....etc bis 23:59
Jetzt fehlt mir nur noch wie ich es schaffe die Daten aus dem Sheet DATA2 in das Sheet Welcome (dashboard) zu bekommen, aber eben das da nur die 10 aktuellsten einträge sichtbar sind - sprich wie haben die Uhrzeit 10:04 und die einträge zb:von 09:45h bis 10:38 sichtbar! (10 aktuellsten einträge)
Hiermal soweit mein code um die daten in die zu holen und in das Workbook zu importieren

Code:
Sub AusführenUpdate()
Call INFOHOLEN
Call Ausfuhren

End Sub

Sub INFOHOLEN()
Sheets("DATA2").Select
Dim fs As Object
Dim fVerz As Object
Dim fDatei As Object
Dim fdateien As Object
Dim strDat As String
Dim Zeile As Integer

Set fs = CreateObject("scripting.FileSystemObject")
Set fVerz = fs.getFolder("\\data\users\Privat\OUTLOOK FILES")
Set fdateien = fVerz.Files

For Each fDatei In fdateien
   If InStr(fDatei, "TeamA-" & Format(Now, "YYYYMMDD")) > 0 Then
       Zeile = Zeile + 50
       Cells(Zeile, 1) = fDatei.Name
   End If
Next fDatei

End Sub

Sub Ausfuhren()


Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object


pfad = "\\data\users\Privat\OUTLOOK FILES"
datei = Range("A50")
blatt = "Resume"
Set bereich = Range("A3:U11")


For Each zelle In bereich
 

 zelle = zelle.Address(False, False)

 ActiveSheet.Cells(zelle.Row + 47, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle

End Sub


Private Function GetValue(pfad, datei, blatt, zelle)



Dim arg As String


If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If

arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)


GetValue = ExecuteExcel4Macro(arg)
Sheets("WELCOME").Select
End Function

vielen dank an euch!
Mika
Top
#2
Hallöchen,

wenn eine Sortierung möglich ist würde ich sortieren und dann ja nach Wunsch die ersten oder letzten 10 Zeilen übertragen.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • sanchezch
Top
#3
http://www.vba-forum.de/forum/View.aspx?..._Dashboard
[-] Folgende(r) 1 Nutzer sagt Danke an Mase für diesen Beitrag:
  • sanchezch
Top
#4
Hallo Schauan,

erstmal danke für die Idee,das habe ich jetzt versucht aber ich komm nicht draus wie ich es machen soll

hast du mir evtl einen Code dafür? Wäre dir sehr dankbar

lg
Top
#5
Hallöchen,

hier mal der relevante Codeschnipsel als Ansatz.

Code:
Sub test()
Cells(Rows.Count, 1).End(xlUp).Offset(-9, 0).Resize(10, 4).Copy
Sheets("Tabelle2").Cells(1, 5).PasteSpecial
End Sub

Wenn Du die Datei offen und das Blatt mit den Quelldaten aktiviert hast, passiert folgendes

Cells(Rows.Count, 1).End(xlUp) --> die letzte verwendete Zelle in Spalte A wird ermittelt
.Offset(-9, 0) --> davon ausgehend 9 weitere Zeilen hoch
.Resize(10, 4) --> und nun 10 Zeilen und 4 Spalten
.Copy --> kopieren

Sheets("Tabelle2") --> Ich habe als Zielblatt Tabelle2, das müsstest Du zumindest ändern.
.Cells(1, 5).PasteSpecial --> eingefügt wird in E1, muss sicher auch wo anders hin. Falls die Daten an vorhandene angefügt werden sollen - siehe erste Zeile im Makro Smile


Zitat: Sheet DATA2 in das Sheet Welcome (dashboard)
Falls die beiden Blätter in unterschiedlichen Dateien sind, müsste man das im Code noch berücksichtigen
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste