Schleifenproblem

Forumthread: Schleifenproblem

Schleifenproblem

09.05.2006 20:00:37

Heinz

Hallo zusammen
Wie löst man ein solches Problem?
Eine periodisch erstellte Tabelle enthält jeweils unterschiedlich viele Datensätze (A10:Axx) in der auch leere Zellen vorkommen können.
Die Zellen B10:Bxx sowie C10:Cxx sollen nun zusätzliche berechnete Werte erhalten, aber nur dann, wenn die entsprechende A-Zelle nicht leer ist.
Ich möchte das nicht mit "wenn...dann" lösen, sondern mit einem Makro, resp. einer VBA-Schleife. Ein entsprechendes Beispiel habe ich beigefügt.
https://www.herber.de/bbs/user/33483.xls
Vielen Dank für Eure Unterstützung!
Heinz

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Schleifenproblem

09.05.2006 20:34:39

Erich
AW: Schleifenproblem

09.05.2006 20:37:26

Franz
Danke!

09.05.2006 21:14:06

Heinz
AW: Danke!

09.05.2006 21:57:46

Erich

AW: Schleifenproblem

09.05.2006 20:34:39

Erich

Hallo Heinz,
versuchs mal mit dem folgenden Makro.
Achtung, da steht auch drin, dass vor dem Schreiben der Formeln die Inhalte der Spalten B und C gelöscht werden.

Option Explicit
Sub Formeln_ergaenzen()
Dim lngLast As Long, rg As Range, lngZ As Long, strFrm As String, zz As Long
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
Set rg = Columns(1).Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=False)
If rg Is Nothing Then Exit Sub
lngZ = rg.Row
'                                                     Formel in Spalte B
Columns(2).ClearContents
Set rg = Cells(lngZ, 2)
For zz = lngZ + 1 To lngLast
If Cells(zz, 1) > "" Then Set rg = Union(rg, Cells(zz, 2))
Next zz
strFrm = "=WENN(A" & lngZ & " <>"""";$A$1+A" & lngZ & ";"""")"
rg.FormulaLocal = strFrm
'                                                     Formel in Spalte C
Columns(3).ClearContents
Set rg = Cells(lngZ, 3)
For zz = lngZ + 1 To lngLast
If Cells(zz, 1) > "" Then Set rg = Union(rg, Cells(zz, 3))
Next zz
strFrm = "=WENN(A" & lngZ & " <>"""";A" & lngZ & "*1,5;"""")"
rg.FormulaLocal = strFrm
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Schleifenproblem

09.05.2006 20:37:26

Franz

Hallo Heinz,
das folgende Makro fügt in den Zeilen mit Werten in Spalte A die Formeln ein.


Sub Formeln_in_BundC()
'Fügt Formeln in den Spalten B und C ein
For I = 10 To ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
If Not IsEmpty(Cells(I, 1)) Then
Cells(I, 2).FormulaR1C1 = "=IF(RC[-1]<>"""",R1C1+RC[-1],"""")"
Cells(I, 3).FormulaR1C1 = "=IF(RC[-2]<>"""",RC[-2]*1.5,"""")"
End If
Next I
End Sub

Gruß
Franz

Danke!

09.05.2006 21:14:06

Heinz

Hallo Erich
Hallo Franz
herzlichen Dank für Eure Lösungen!!!
Bei der Variante von Erich wird die Spalte B korrekt ausgefüllt. Anschliessend wird folgende Meldung angezeigt: "Laufzeitfehler '1004': Anwendungs- oder obkektorientierter Fehler" Nach dem Klick auf "Debuggen" ist der Text der letzten Zeile vor dem End Sub (rg.FormulaLocal = strFrm) gelb hinterlegt.
Die Variante von Franz läuft einwandfrei, insbesondere wurde auch die Startzelle berücksichtigt.
Nochmals herzlichen Dank euch beiden!

AW: Danke!

09.05.2006 21:57:46

Erich

Hallo Heinz,
aus Franz' und meiner (umständlichen) Lösung hab ich noch eine Kombination gebastelt:

Sub Formeln_ergaenzen_abZ10()
Dim rg As Range, zz As Long
Const lngZ = 10&
[B:C].ClearContents
'                             in Spalte B zu belegende Zellen
Set rg = Cells(lngZ, 2)
For zz = lngZ + 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Not IsEmpty(Cells(zz, 1)) Then Set rg = Union(rg, Cells(zz, 2))
Next zz
'                             Formeln eintragen in Spalten B und C
rg.FormulaR1C1 = "=R1C1+RC[-1]"
rg.Offset(0, 1).FormulaR1C1 = "=RC[-2]*1.5"
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

Forumthread: Schleifenproblem

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

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread