Teile einer Zelle in Diagramm kopieren

Hallo an alle!
Ich hab mal wieder ein größeres Problem. Ich hoffe, dass es hier einen Spezi gibt, der mir weiterhelfen kann.
Ich habe eine Tabelle, wie ich sie unter https://www.herber.de/bbs/user/13081.xls eingefügt habe.
Ich möchte nun in der "Kalkulation" unter OEM-Nr-Eingabe einen Artikel bestimmen. Dieser Artikel befindet sich mit den Verlauf der Preisentwicklung in meinem Tabellenblatt "Preisentwicklung". Wenn ich nun auf den Refresh-Button klicke möchte ich gerne, dass der entsprechende Artikel aus "Preisentwicklung" herausgesucht wird und, dass die letzten 10 Einträge dieses Artikels in die Tabelle im Arbeitsblatt "Tabelle" kopiert werden und das Diagramm auf den Arbeitsblatt "Kalkulation" nun den aktuellen Verlauf der Preisentwicklung grafisch darstellt. Wichtig ist, dass es auch vorkommen kann, dass es weniger als 10 Einträge geben kann.
Ich denke, dass es sicherlich nicht üblich ist, solche komplexen Probleme hier im Forum zu posten. Mit einer Antwort würdet ihr mir aber sehr weiterhelfen.
Vielen Dank schonmal im voraus.
Thorben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

probier das einmal:

Option Explicit
Option Private Module
Sub diagr_akt()
Dim sh As Worksheet, sh1 As Worksheet, sh2 As Worksheet
Dim i As Integer, s As Integer
Dim erste As Integer, letzte As Byte, z As Range
Dim letzte1 As Integer
   Set sh = Sheets("Kalkulation")
   Set sh1 = Sheets("Preisentwicklung")
   Set sh2 = Sheets("Tabelle")
   Set z = sh.[b10]

On Error Resume Next
  For i = 2 To 100
    If sh1.Cells(i, 1).Value = z Then
      erste = sh.Cells(i, 2).Row
     Exit For
  End If
Next
sh2.[b6:k6] = ""
sh2.[b3:k4] = ""
sh2.Range(sh2.Cells(6, 2), sh2.Cells(6, 11)).Value = _
sh1.Range(sh1.Cells(erste, 2), sh1.Cells(erste, 11)).Value
For s = 2 To 11
  If sh2.Cells(6, s) > 0 Then
      sh2.Cells(7, s).Value = Left(sh2.Cells(6, s), 5)
       sh2.Cells(8, s) = Mid(sh2.Cells(6, s), 9, 6)
    End If
  Next

sh2.Range(sh2.Cells(3, 2), sh2.Cells(4, 11)).Value = _
sh2.Range(sh2.Cells(7, 2), sh2.Cells(8, 11)).Value
sh2.[b6:k8] = ""
letzte1 = sh2.Cells(3, Columns.Count).End(xlToLeft).Column
With sh
   .Activate
    .ChartObjects(1).Activate
     With ActiveChart
        .SeriesCollection(1).Values = "=Tabelle!R3C2:R3C" & letzte1
        .SeriesCollection(1).XValues = "=Tabelle!R4C2:R4C" & letzte1
     End With
  .[b10].Activate
End With
End Sub
'ins Tabellenmodul
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, [b10]) Is Nothing Then
Call diagr_akt
End If
Application.ScreenUpdating = True
End Sub

gruß Herbert
https://www.herber.de/bbs/user/13092.xls

Beliebteste Forumthreads (12 Monate)

Teile einer Zelle in Diagramm kopieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

320 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Teile einer Zelle in Diagramm kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

320 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread