Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
424to428
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
424to428
424to428
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Hilfe benötigt: Makro soll erweitert werden

Hilfe benötigt: Makro soll erweitert werden
Daniel
Hallo Zusammen!
Ich habe ein Makro, das erweitert werden soll.
Das Makro berechnet mir aus einer Tabelle "Data" einen Wert, der in das Blatt "1dROCs" kopiert werden soll. Dies schaffe ich bis hierher wir gewünscht.
Zudem möchte ich gerne die 1. Zeile und die 1. Spalte komplett ins Blatt "1dROC" übertragen. Wie geht das?
Außerdem möchte ich die gleiche Berechnung und Kopie wie für Spalte B auch für jede restliche Spalte machen. Ist das möglich? Also wenn 10 Spalten gefüllt sind ab B, dann die Berchnung dieser 10 Spalten, wenn es mehr sind, dann eben mehr? Die Spaltenzahl ist also variabel.
Ich wäre für Hilfe sehr dankbar.
Hier noch das Makro:
Option Explicit

Sub ROC_Berechnen()
Dim rng As Range
Dim lngE As Long 'für letzte gefüllte Zeile
Dim lngRow As Long 'Zeilenzähler in "1dROCs"
lngRow = 2
'Letzte gefüllte Zelle in Spalte "B" ermitteln
lngE = IIf(IsEmpty(Sheets("Data").Range("B65536")), _
Sheets("Data").Range("B65536").End(xlUp).Row, 65536)
Sheets("1dROCs").Columns("B").ClearContents 'Spalte "B" in "1dROCs" löschen
For Each rng In Sheets("Data").Range("B2:B" & lngE)
If rng <> "" And rng.Offset(1, 0) <> "" Then
'wenn Zelle in Spalte "B" und "B+1" gefüllt dann
Sheets("1dROCs").Cells(lngRow + 1, 2) = _
(rng.Offset(1, 0) / rng) - 1
lngRow = lngRow + 1 'Zeilenzähler erhöhen
End If
Next
End Sub

Grüße,
Daniel

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Hilfe benötigt: Makro soll erweitert werden
Uwe
Hallo, Daniel!
Vielleicht hilft Dir dieser Lösungsvorschlag weiter:~f~
Option Explicit
Sub ROC_Berechnen()
Dim rng As Range
Dim c As Integer, maxc ' Anzahl de Spalten
Dim lngE As Long 'für letzte gefüllte Zeile
Dim lngRow As Long 'Zeilenzähler in "1dROCs"
Dim wsData As Worksheet, wsROCs As Worksheet
Set wsData = Worksheets("Data")
Set wsROCs = Worksheets("1dROCs")
'Lösche Eintragungen auf 1dROCs
wsROCs.Cells.Delete Shift:=xlUp
'Übertrage Erste Spalte und erste Zeile aus Datablatt
Application.CutCopyMode = False
wsROCs.Select
wsData.Columns("A:A").Copy
wsROCs.Range("A1").Select
wsROCs.Paste
wsData.Rows("1:1").Copy
wsROCs.Range("A1").Select
wsROCs.Paste
wsROCs.Range("A1").Select
maxc = 1
With wsData
'Letzte gefüllte Zelle in Zeile 1 (Überschrift) ermitteln
While IsEmpty(.Cells(1, maxc)) = False: maxc = maxc + 1: Wend
If maxc < 2 Then Exit Sub
'Letzte gefüllte Zelle in Spalte "B" ermitteln
lngE = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
For c = 2 To maxc
lngRow = 2
For Each rng In wsData.Range(.Cells(2, c), .Cells(lngE, c))
If rng <> "" And rng.Offset(1, 0) <> "" Then
'wenn Zelle in Zeile r und r+1 gefüllt dann
wsROCs.Cells(lngRow + 1, c) = (rng.Offset(1, 0) / rng) - 1
lngRow = lngRow + 1 'Zeilenzähler erhöhen
End If
Next rng
Next c
End With
End Sub

~f~
Gruß!
Anzeige
Super, danke!
04.05.2004 22:29:08
Daniel
Hallo Uwe,
das hilft nich nur vielleicht. sondern perfekt!
Vielen, vielen Dank für Deine Mühe...schönen Abend noch.
Grüße
Daniel

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige