Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
720to724
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
720to724
720to724
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Range anders angeben!

Range anders angeben!
23.01.2006 21:36:42
Swen
Hallo an alle,
Wie kann ich in folgender Zeile
ActiveChart.SeriesCollection(2).XValues = "=('Spea-MD-TP'!R3C2,'Spea-MD-TP'!R3C4)"
den Range z.B. so angeben
Worksheets("Spea-MD-TP).Cells(2,2)value & Worksheets("Spea-MD-TP).Cells(2,24)value
ich möchte gerne mit Cells(34,4) bezeichnungen arbeiten!
Gruß
Swen

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Range anders angeben!
23.01.2006 23:01:38
Josef Ehrensberger
Hallo Swen!
Z.B. so1
With Worksheets("Spea-MD-TP")
  ActiveChart.SeriesCollection(2).XValues = .Range(.Cells(2, 2), .Cells(2, 24)).Value
End With

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Range anders angeben!
24.01.2006 21:51:59
Swen
Hallo,
ich habe es wie folgt jetzt in meinem Programm eingefügt
funtzt aber nicht!
Worksheets(PCBName).Cells(intZaehler, 6).Select
If Worksheets(PCBName).Cells(intZaehler, 6).Value = "*" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).XValues = Worksheets(PCBName).Range(Cells(intZaehler, 2), Cells(intZaehler, 4)).Value
ActiveChart.SeriesCollection(2).Values = Worksheets(PCBName).Range(Cells(intZaehler, 3), Cells(intZaehler, 5)).Value
ActiveChart.SeriesCollection(2).Name = Worksheets(PCBName).Cells(intZaehler, 1).Value
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).Points(2).Select
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).Trendlines.Add(Type:=xlLinear).Select
End If
Next intZaehler
Hat jemand eine idee warum?
Gruß
Swen
Anzeige
AW: Range anders angeben!
24.01.2006 22:13:16
Josef Ehrensberger
Hallo Swen!
Wichtig ist der With-Rahmen und die Punkte vor Range() bzw. Cells() !
  'Worksheets(PCBName).Cells(intZaehler, 6).Select 'Nicht notwendig!!!!!
  With Worksheets(PCBName)
    If .Cells(intZaehler, 6).Value = "*" Then
      ActiveChart.SeriesCollection.NewSeries
      ActiveChart.SeriesCollection(2).XValues = .Range(.Cells(intZaehler, 2), .Cells(intZaehler, 4)).Value
      ActiveChart.SeriesCollection(2).Values = .Range(.Cells(intZaehler, 3), .Cells(intZaehler, 5)).Value
      ActiveChart.SeriesCollection(2).Name = .Cells(intZaehler, 1).Value
      ActiveChart.SeriesCollection(2).Trendlines.Add Type:=xlLinear
    End If
  End With
Next intZaehler

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Range anders angeben!
24.01.2006 22:40:01
Swen
Hallo Sepp,
ich bekomme das einfach nicht so hin wie ich es möchte!
ich möchte ein MAkro schreiben was folgendes macht
1. Es erstellt ein Diagramm mit den Punkten in Spalte 2 & 3 ab Zeile 3 bis 130!
2. In dieses Diagramm soll er nun alle Nadelpaare einfügen und mit einer Trendlinie versehen die in Spalte 7 einen * haben! DAs eine ende dieser striche soll das Datenpaar Spalte 2 & 3 sein und das andere ende spalte 4 & 5!
So das ich dann Striche( 25 Stück) im Diagramm habe die von einem der vorrigen Punkten in die mitte des Diagramm zeigen!
Hast du eine idee wie ich dieses machen kann!
Anbei ein Daten blatt aus den ich so eine Diagramm erstellen möcht!

Die Datei https://www.herber.de/bbs/user/30350.xls wurde aus Datenschutzgründen gelöscht

Gruß
Swen
Anzeige
AW: Range anders angeben!
24.01.2006 22:45:03
Swen
Hallo Sepp,
das war mein ansatz!

Sub Epoxy_Plan_erstellen()
PCBName = "Tabelle1"
'**** Diagramm mit Lötpunkten erstellen *****'
Worksheet_suchen ("Layout3")
If blnSearchResult = True Then
Worksheets("Layout3").Select
Selection.Delete
End If
With Sheets(PCBName)
ModulFunktion1.Diagramm_erstellen .Range(.Cells(3, 2), .Cells((Worksheets(PCBName) _
.Cells(1, 2).Value + 2), 3)), .Cells(1, 1)
End With
'**** Nadeln ziehen'
Dim intZaehler As Integer
Dim intZaehler22 As Integer
intZaehler22 = 2
For intZaehler = 3 To Worksheets(PCBName).Cells(1, 2).Value + 2
With Worksheets(PCBName)
If .Cells(intZaehler, 6).Value = "*" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(intZaehler22).XValues = .Range(.Cells(intZaehler, 2), .Cells(intZaehler, 4)).Value
ActiveChart.SeriesCollection(intZaehler22).Values = .Range(.Cells(intZaehler, 3), .Cells(intZaehler, 5)).Value
ActiveChart.SeriesCollection(intZaehler22).Name = .Cells(intZaehler, 1).Value
ActiveChart.SeriesCollection(intZaehler22).Trendlines.Add Type:=xlLinear
intZaehler22 = intZaehler22 + 1
End If
End With
Next intZaehler
End Sub

gruß
swen
Anzeige
AW: Range anders angeben!
24.01.2006 23:58:33
Josef Ehrensberger
Hallo Swen!
Sorry, aber da blicke ich nicht durch.
So sieht's bei mir aus.
https://www.herber.de/bbs/user/30355.xls
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Range anders angeben!
25.01.2006 18:21:17
Swen
Hallo Sepp,
evtl. kann ich dir nochmal etwas genauer erklären was ich eigentlich möchte!
schau dir hierzu einmal die folgende Exceltabelle bitte an!
https://www.herber.de/bbs/user/30388.zip
Du scheinst einer der besten zu sein in Bezug auf Diagramme & VBA, daher möchte ich dich bitten mir weiter zuhelfen!
Gruß
Swen
AW: Range anders angeben!
25.01.2006 19:17:57
Josef Ehrensberger
Hallo Swen!
Meinst du so?
https://www.herber.de/bbs/user/30390.xls
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Range anders angeben!
25.01.2006 19:54:24
Swen
Hallo Sepp,
genau so meinte ich!
Gruß
Swen
AW: Range anders angeben!
25.01.2006 19:57:42
Swen
Hallo Sepp,
ist es möglich das man an die Punkte die benutzt werden (also wo ein Strich gezogen wird)
aussen auch die Bezecihnung der Spalte 1 einfügt!
Gruß
Swen
AW: Range anders angeben!
25.01.2006 20:37:45
Josef Ehrensberger
Hallo Swen!
Geht auch!
Sub Epoxy_Plan_erstellen()
Dim chrt As Chart
PCBName = "Tabelle1"
'**** Diagramm mit Lötpunkten erstellen *****'
' Worksheet_suchen ("Layout3")
'
' If blnSearchResult = True Then
' Worksheets("Layout3").Select
' Selection.Delete
' End If
'
'
' With Sheets(PCBName)
' ModulFunktion1.Diagramm_erstellen .Range(.Cells(3, 2), .Cells((Worksheets(PCBName) _
  ' .Cells(1, 2).Value + 2), 3)), .Cells(1, 1)
' End With
'**** Nadeln ziehen'
With Worksheets(PCBName)
  Set chrt = .ChartObjects(1).Chart
  chrt.SeriesCollection(1).XValues = .Range(.Cells(3, 2), .Cells(.Cells(1, 2) + 2, 2))
  chrt.SeriesCollection(1).Values = .Range(.Cells(3, 3), .Cells(.Cells(1, 2) + 2, 3))
  Dim intZaehler As Integer
  Dim intZaehler22 As Integer
  intZaehler22 = 2
  ' "alte" Nadeln löschen
  On Error Resume Next
  For intZaehler = chrt.SeriesCollection.Count To 2 Step -1
    chrt.SeriesCollection.Item(intZaehler).Delete
  Next
  On Error GoTo 0
  For intZaehler = 3 To .Cells(1, 2).Value + 2
    If .Cells(intZaehler, 6).Value = "*" Then
      chrt.SeriesCollection.NewSeries
      chrt.SeriesCollection(intZaehler22).XValues = "{" & .Cells(intZaehler, 2) & "," & .Cells(intZaehler, 4) & "}"
      chrt.SeriesCollection(intZaehler22).Values = "{" & .Cells(intZaehler, 3) & "," & .Cells(intZaehler, 5) & "}"
      chrt.SeriesCollection(intZaehler22).Name = .Cells(intZaehler, 1).Value
      chrt.SeriesCollection(intZaehler22).ApplyDataLabels Type:=xlDataLabelsShowLabel
      chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Text = .Cells(intZaehler, 1).Text
      chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Position = IIf((.Cells(intZaehler, 3) Or .Cells(intZaehler, 5)) > 0, xlLabelPositionAbove, xlLabelPositionBelow)
      chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Font.Size = 8
      chrt.SeriesCollection(intZaehler22).DataLabels.Item(2).Delete
      chrt.SeriesCollection(intZaehler22).ChartType = xlXYScatterLinesNoMarkers
      chrt.SeriesCollection(intZaehler22).Border.ColorIndex = 5
      chrt.SeriesCollection(intZaehler22).MarkerStyle = xlNone
      intZaehler22 = intZaehler22 + 1
    End If
  Next intZaehler
End With
End Sub



'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Range anders angeben!
25.01.2006 22:53:39
Swen
Hallo Sepp,
sorry aber eine Sache noch wie kann ich das diagramm vorher erstellen mit
dem Hintergrund denn du gewählt hattest!
Also wenn ich das Diagramm lösche soll er dieses komplett erstellen!
Gruß
Swen
AW: Range anders angeben!
25.01.2006 23:53:59
Josef Ehrensberger
Hallo Swen!
Mit den Rekorder aufzeichnen und nachher den Code überarbeiten!
Das müsste ich auch!
Gruß Sepp
AW: Range anders angeben!
26.01.2006 01:07:03
Swen
Hallo Sepp,
das versuche ich aber es funtzt nicht!
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Worksheets(PCBName).Range(Cells(3, 2), Cells(intbis2, 3)), _
PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:=PCBName
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
das ist mein ergens aber er steigt immer bei
ActiveChart.SetSourceData Source:=Worksheets(PCBName).Range(Cells(3, 2), Cells(intbis2, 3)), _
PlotBy:=xlColumns
aus
gruß
swen
Anzeige
AW: Range anders angeben!
26.01.2006 01:14:55
Josef Ehrensberger
Hallo Swen!
Warum willst du das Diagramm eigentlich jedesmal neu erstellen?
Es genügt doch die Daten neu zuzuweisen.
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Range anders angeben!
26.01.2006 01:23:13
Swen
HAllo Sepp,
da die DAtei nicht immer vorhanden ist sondern,
vorher erst erstellt wird aus mehreren Worksheets!
somit wird das blatt erst erstellt mit den werten und
dann erst das ddiagramm!
gruß
swen
AW: Range anders angeben!
26.01.2006 01:45:45
Josef Ehrensberger
Hallo Swen!
Also dann!
Den Code von den Selects und Activates zu bereinigen, kannst du selber noch fortsetzen!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Epoxy_Plan_erstellen()
Dim intZaehler As Integer
Dim intZaehler22 As Integer
Dim PCBName As String
Dim objCh As ChartObject
Dim chrt As Chart

Application.ScreenUpdating = False

PCBName = "Tabelle1"
'**** Diagramm mit Lötpunkten erstellen *****'
' Worksheet_suchen ("Layout3")
'
' If blnSearchResult = True Then
' Worksheets("Layout3").Select
' Selection.Delete
' End If
'
'
' With Sheets(PCBName)
' ModulFunktion1.Diagramm_erstellen .Range(.Cells(3, 2), .Cells((Worksheets(PCBName) _
  ' .Cells(1, 2).Value + 2), 3)), .Cells(1, 1)
' End With
'**** Nadeln ziehen'
With Worksheets(PCBName)
  For Each objCh In .ChartObjects
    objCh.Delete
  Next
  ' chrt.SeriesCollection(1).XValues = .Range(.Cells(3, 2), .Cells(.Cells(1, 2) + 2, 2))
  ' chrt.SeriesCollection(1).Values = .Range(.Cells(3, 3), .Cells(.Cells(1, 2) + 2, 3))
  
  makeChart .Range(.Cells(3, 2), .Cells(.Cells(1, 2) + 2, 3))
  
  Set chrt = .ChartObjects(1).Chart
  
  intZaehler22 = 2
  ' "alte" Nadeln löschen
  On Error Resume Next
  For intZaehler = chrt.SeriesCollection.Count To 2 Step -1
    chrt.SeriesCollection.Item(intZaehler).Delete
  Next
  On Error GoTo 0
  For intZaehler = 3 To .Cells(1, 2).Value + 2
    If .Cells(intZaehler, 6).Value = "*" Then
      chrt.SeriesCollection.NewSeries
      chrt.SeriesCollection(intZaehler22).XValues = "{" & .Cells(intZaehler, 2) & "," & .Cells(intZaehler, 4) & "}"
      chrt.SeriesCollection(intZaehler22).Values = "{" & .Cells(intZaehler, 3) & "," & .Cells(intZaehler, 5) & "}"
      chrt.SeriesCollection(intZaehler22).Name = .Cells(intZaehler, 1).Value
      chrt.SeriesCollection(intZaehler22).ApplyDataLabels Type:=xlDataLabelsShowLabel
      chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Text = .Cells(intZaehler, 1).Text
      chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Position = IIf((.Cells(intZaehler, 3) Or .Cells(intZaehler, 5)) > 0, xlLabelPositionAbove, xlLabelPositionBelow)
      chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Font.Size = 8
      chrt.SeriesCollection(intZaehler22).DataLabels.Item(1).Font.ColorIndex = 5
      chrt.SeriesCollection(intZaehler22).DataLabels.Item(2).Delete
      chrt.SeriesCollection(intZaehler22).ChartType = xlXYScatterLinesNoMarkers
      chrt.SeriesCollection(intZaehler22).Border.ColorIndex = 5
      chrt.SeriesCollection(intZaehler22).MarkerStyle = xlNone
      intZaehler22 = intZaehler22 + 1
    End If
  Next intZaehler
End With

Application.ScreenUpdating = True
End Sub


Sub makeChart(ByVal myRange As Range)
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=myRange, _
  PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:=myRange.Parent.Name
With ActiveChart
  .HasTitle = False
  .Axes(xlCategory, xlPrimary).HasTitle = False
  .Axes(xlValue, xlPrimary).HasTitle = False
End With
With ActiveChart.Axes(xlCategory)
  .HasMajorGridlines = False
  .HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
  .HasMajorGridlines = False
  .HasMinorGridlines = False
End With
ActiveChart.HasLegend = False
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False
ActiveChart.Axes(xlCategory).Select
With Selection.Border
  .LineStyle = xlNone
End With
With Selection
  .MajorTickMark = xlNone
  .MinorTickMark = xlNone
  .TickLabelPosition = xlNextToAxis
End With
Selection.TickLabels.AutoScaleFont = False
With Selection.TickLabels.Font
  .Name = "Tahoma"
  .FontStyle = "Standard"
  .Size = 8
  .ColorIndex = 56
  .Background = xlTransparent
End With
Selection.TickLabels.NumberFormat = "#,##0,"
Selection.TickLabels.Orientation = xlUpward
ActiveChart.Axes(xlValue).Select
With Selection.Border
  .LineStyle = xlNone
End With
With Selection
  .MajorTickMark = xlNone
  .MinorTickMark = xlNone
  .TickLabelPosition = xlNextToAxis
End With
Selection.TickLabels.AutoScaleFont = False
With Selection.TickLabels.Font
  .Name = "Tahoma"
  .FontStyle = "Standard"
  .Size = 8
  .ColorIndex = 56
  .Background = xlTransparent
End With
Selection.TickLabels.NumberFormat = "#,##0,"
ActiveChart.PlotArea.Select
With Selection.Border
  .LineStyle = xlNone
End With
Selection.Interior.ColorIndex = xlNone
ActiveChart.ChartArea.Select
With Selection.Border
  .LineStyle = 0
End With
Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, _
  Degree:=0.831357289997711
With Selection
  .Fill.ForeColor.SchemeColor = 15
End With
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).ScaleHeight 1.36, msoFalse, _
  msoScaleFromTopLeft
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Top = 100
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Left = 375
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Width = 490
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Height = 490
ActiveChart.PlotArea.Select
Selection.Top = 1
Selection.Height = 499
Selection.Left = 1
Selection.Width = 499

ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Activate
ActiveChart.SeriesCollection(1).Select
With Selection.Border
  .Weight = xlHairline
  .LineStyle = xlNone
End With
With Selection
  .MarkerBackgroundColorIndex = 44
  .MarkerForegroundColorIndex = 46
  .MarkerStyle = xlCircle
  .MarkerSize = 5
End With
End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige