Hallo in die Runde,
folgende Problematik: Ich habe eine Excel-Datei mit zwei Datenblättern "Datenanalyse (automatisch)" und "Datenspeicherung (automatisch).
Ich habe nun Werte aus dem Quelldatenblatt (Datenanalyse (automatisch)) die in das Zieldatenblatt (Datenspeicherung (automatisch)) kopiert werden sollen wenn
ich auf einen Button klicke. Die Werte sind dabei später durch verschiedene Formeln berechnet.
Immer wenn ich auf den Button klicke sollen die Daten kopiert werden und zwar in die nächst leere Spalte.
Ein Mitglied dieses Forums hat mir bereits ein Makros zukommen lassen, welches perfekt funktioniert. Alle in der Mustertabelle gelb und grün markierten Werte werden kopiert und es wird immer die nächst leere Spalte im Zieldatenblatt genutzt.
Jetzt zur eigentlichen Thematik: Jedes Mal wenn das Markos ausgeführt wird und die Daten kopiert werden soll automatisch die dazugehörige (wenn vorhanden) Benchmark mit eingefügt werden. Das sind die grau eingetragenen Werte.
Ich hoffe ich habe die Thematik verständlich erklärt und hoffe es kann mir jemand weiterhelfen. Danke schon Mal!
VG Felix
Sub x()
Dim arr As Variant
Dim i As Long
Dim j As Long
Dim col As Long
arr = Worksheets("Datenanalyse (automatisch)").Range("A1:F42")
With Worksheets("Datenspeicherung (automatisch)")
col = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
.Cells(1, col) = arr(3, 2)
j = 2
For i = 6 To 15
.Cells(j, col) = arr(i, 6)
.Cells(j + 1, col) = arr(i, 5)
j = j + 3
Next i
For i = 19 To 28
.Cells(j, col) = arr(i, 6)
.Cells(j + 1, col) = arr(i, 5)
j = j + 3
Next
For i = 32 To 42
.Cells(j, col) = arr(i, 3)
j = j + 1
Next
.Columns(2).Copy
.Columns(col).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End With
End Sub
Hallo
Zitat:...und es wird immer die nächst leere Spalte im Zieldatenblatt genutzt.
Jetzt zur eigentlichen Thematik: Jedes Mal wenn das Markos ausgeführt wird und die Daten kopiert werden soll automatisch die dazugehörige (wenn vorhanden) Benchmark mit eingefügt werden. Das sind die grau eingetragenen Werte.
Ich hoffe ich habe die Thematik verständlich erklärt und hoffe es kann mir jemand weiterhelfen. Danke schon Mal!
VG Felix
Die Änderung war mal von mir.
Hier der Code für die Benchmarks.
Die Sonderwünsche sind mit abgearbeitet
kleinergleich, größergleich sowie das 1 : werden gelöscht
bei von - bis wird nur der hintere Teil verwendet
Code:
Sub x()
Dim arr As Variant
Dim i As Long
Dim j As Long
Dim col As Long
Dim Bench As String
arr = Worksheets("Datenanalyse (automatisch)").Range("A1:F42")
With Worksheets("Datenspeicherung (automatisch)")
col = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
.Cells(1, col) = arr(3, 2)
j = 2
For i = 6 To 15
.Cells(j, col) = arr(i, 6)
.Cells(j + 1, col) = arr(i, 5)
Bench = CStr(arr(i, 4))
Bench = Replace(Bench, ChrW(8804) & " ", "") 'KleinerGleich
Bench = Replace(Bench, ChrW(8805) & " ", "") 'GrößerGleich
Bench = Replace(Bench, "1 : ", "") ' 1: entfernen
If InStr(Bench, "-") > 0 Then 'von bis entfernen
Bench = Mid(Bench, InStr(Bench, "-") + 1)
End If
.Cells(j + 2, col) = Bench
j = j + 3
Next i
For i = 19 To 28
.Cells(j, col) = arr(i, 6)
.Cells(j + 1, col) = arr(i, 5)
Bench = CStr(arr(i, 4))
Bench = Replace(Bench, ChrW(8804) & " ", "") 'KleinerGleich
Bench = Replace(Bench, ChrW(8805) & " ", "") 'GrößerGleich
Bench = Replace(Bench, "1 : ", "") ' 1: entfernen
If InStr(Bench, "-") > 0 Then 'von bis entfernen
Bench = Mid(Bench, InStr(Bench, "-") + 1)
End If
.Cells(j + 2, col) = Bench
j = j + 3
Next
For i = 32 To 42
.Cells(j, col) = arr(i, 3)
j = j + 1
Next
.Columns(2).Copy
.Columns(col).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End With
End Sub
LG UweD
Top Danke, Uwe. Funktioniert wie beim letzten Mal einwandfrei!
Hallo - kleines Problem.
das Markos funktioniert an sich. Die Benchmarks werden nun deklariert als "Text gespeicherte Zahl". Ich benötige die Werte, um Diagramme zu erstellen.
Bedeutet ich benötige die Benchmarks als Zahlen definiert. Kann man den Markos dementsprechend anpassen oder tun sich hier Grenzen auf?
VG Felix
(14.08.2023, 10:29)UweD schrieb: [ -> ]Hallo
Die Änderung war mal von mir.
Hier der Code für die Benchmarks.
Die Sonderwünsche sind mit abgearbeitet
kleinergleich, größergleich sowie das 1 : werden gelöscht
bei von - bis wird nur der hintere Teil verwendet
Code:
Sub x()
Dim arr As Variant
Dim i As Long
Dim j As Long
Dim col As Long
Dim Bench As String
arr = Worksheets("Datenanalyse (automatisch)").Range("A1:F42")
With Worksheets("Datenspeicherung (automatisch)")
col = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
.Cells(1, col) = arr(3, 2)
j = 2
For i = 6 To 15
.Cells(j, col) = arr(i, 6)
.Cells(j + 1, col) = arr(i, 5)
Bench = CStr(arr(i, 4))
Bench = Replace(Bench, ChrW(8804) & " ", "") 'KleinerGleich
Bench = Replace(Bench, ChrW(8805) & " ", "") 'GrößerGleich
Bench = Replace(Bench, "1 : ", "") ' 1: entfernen
If InStr(Bench, "-") > 0 Then 'von bis entfernen
Bench = Mid(Bench, InStr(Bench, "-") + 1)
End If
.Cells(j + 2, col) = Bench
j = j + 3
Next i
For i = 19 To 28
.Cells(j, col) = arr(i, 6)
.Cells(j + 1, col) = arr(i, 5)
Bench = CStr(arr(i, 4))
Bench = Replace(Bench, ChrW(8804) & " ", "") 'KleinerGleich
Bench = Replace(Bench, ChrW(8805) & " ", "") 'GrößerGleich
Bench = Replace(Bench, "1 : ", "") ' 1: entfernen
If InStr(Bench, "-") > 0 Then 'von bis entfernen
Bench = Mid(Bench, InStr(Bench, "-") + 1)
End If
.Cells(j + 2, col) = Bench
j = j + 3
Next
For i = 32 To 42
.Cells(j, col) = arr(i, 3)
j = j + 1
Next
.Columns(2).Copy
.Columns(col).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End With
End Sub
LG UweD
Hallo - kleines Problem.
das Markos funktioniert an sich. Die Benchmarks werden nun deklariert als "Text gespeicherte Zahl". Ich benötige die Werte, um Diagramme zu erstellen.
Bedeutet ich benötige die Benchmarks als Zahlen definiert. Kann man den Markos dementsprechend anpassen oder tun sich hier Grenzen auf?
VG Felix
Hi,
die variable Bench ist als String definiert. Daher wird die "Zahl" als Text in die Zelle geschrieben. Z.B. mit der Zeile
Code:
.Cells(j + 2, col) = Bench
Wenn hier eine Zahl in der Zelle landen soll, musst du den Text umwandeln:
Code:
.Cells(j + 2, col) = CLng(Bench). 'oder CDbl falls es eine Kommazahl ist
Mit dem angepassten Code funktioniert es leider nicht:
Sub Analyse_Speichern2()
Dim arr As Variant
Dim i As Long
Dim j As Long
Dim col As Long
Dim Bench As String
arr = Worksheets("Datenanalyse (automatisch)").Range("A1:F42")
With Worksheets("Datenspeicherung (automatisch)")
col = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
.Cells(1, col) = arr(3, 2)
j = 2
For i = 6 To 15
.Cells(j, col) = arr(i, 6)
.Cells(j + 1, col) = arr(i, 5)
Bench = CStr(arr(i, 4))
Bench = Replace(Bench, ChrW(8804) & " ", "") 'KleinerGleich
Bench = Replace(Bench, ChrW(8805) & " ", "") 'GrößerGleich
Bench = Replace(Bench, "1 : ", "") ' 1: entfernen
If InStr(Bench, "-") > 0 Then 'von bis entfernen
Bench = Mid(Bench, InStr(Bench, "-") + 1)
End If
.Cells(j + 2, col) = CDbl(Bench)
j = j + 3
Next i
For i = 19 To 28
.Cells(j, col) = arr(i, 6)
.Cells(j + 1, col) = arr(i, 5)
Bench = CStr(arr(i, 4))
Bench = Replace(Bench, ChrW(8804) & " ", "") 'KleinerGleich
Bench = Replace(Bench, ChrW(8805) & " ", "") 'GrößerGleich
Bench = Replace(Bench, "1 : ", "") ' 1: entfernen
If InStr(Bench, "-") > 0 Then 'von bis entfernen
Bench = Mid(Bench, InStr(Bench, "-") + 1)
End If
.Cells(j + 2, col) = CDbl(Bench)
j = j + 3
Next
For i = 32 To 42
.Cells(j, col) = arr(i, 3)
j = j + 1
Next
.Columns(2).Copy
.Columns(col).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End With
End Sub
Wow,
nach 6 Tagen eine Reaktion. Wahnsinn! Weist du wie mühsam es für uns Helfer ist, sich nach 6 Tagen wieder an das Problem zu erinnern? Und hättest du dich mit einem Danke gemeldet, wenn es problemlos funktioniert hätte?
Soviel zum anständigen Umgang untereinander. Dazu gehört auch, das man Code in Code-Tags setzt.
Zum Problem: es wäre Hilfreich, wenn du dazu schreiben würdest, was genau nicht funktioniert. Das würde einen Lösungsansatz deutlich vereinfachen. Ich bin jetzt mal davon ausgegangen, dass es immer noch die selbe Datei ist und habe deine letzte Version heruntergeladen und dort den eben gezeigten Code eingefügt. Wenn ich jetzt den Code starte, dann springt der Debugger in der Zeile nach dem ersten "End If" an und zeigt einen "Laufzeitfehler 13: Typenkonflikt" an. Sieht man sich den Inhalt von "Bench" zu diesem Zeitpunkt an, dann steht dort "5,00%". Und das ist für CDbl() leider keine Zahl und kann daher nicht umgewandelt werden. Also sorgen wir dafür, dass VBA bzw. Excel diesen Streng direkt beim Eintrag in eine Zahl umwandelt. Dazu müssen wir nur das Komma in einen Punkt umwandeln (übrigens CDbl() würde das automatisch machen, kommt aber mit dem % nicht klar). Also füge die Zeile
Code:
Bench = Replace(Bench, ",", ".") 'Komma durch Punkt ersetzen (amerikanische Zahl)
zu den Replace-Orgien hinzu und lösche das CDbl() wieder.
Noch ein Tipp zum Schluss: lass in der Formatierung der Zellen das unsägliche Zentrieren sein, dann fallen solche "Fehler" wie "Text statt Zahl" viel früher auf, denn Zahlen werden von Excel automatisch rechtsbündig und Texte linksbündig gesetzt, da sieht man dann sofort ob 5% als Zahl oder Text in der Zelle steht.
Hallo,
entschuldige bitte die späte Rückmeldung - die Umstände ließen es leider nicht zu..
Ich danke dir für deine Mühen. Mit der Anpassung funktioniert es einwandfrei. Danke!
VG Felix