Makro zum Ändern von Werten auf mehreren Tabellenblättern

[okabambu]

Hallo zusammen,

ich habe ein Calc-Dokument mit vielen Tabellenblättern.
In Spalte C stehen in den Zeilen unterschiedliche Wörter
In Spalte D steht der dazugehörige Wert
Leider ist die Anzahl der Zeilen auf jedem Tabellenblatt unterschiedlich
Einige Tabellenblätter haben keine Wörter/Werte eingetragen
Die Werte in Spalte D sind auf jedem Tabellenblatt unterschiedlich

Nun suche ich nach einem Tipp für ein Makro mit folgender Funktion:

1. Suche nach einem String in Spalte C (z.B. Suchbegriff: "ABC")
2. Ändere den Wert in der entsprechenden Zeile der Spalte D (dividiere durch 2)
3. Dies soll auf allen Tabellenblättern erfolgen

Ich habe schon die Makro-Befehle Search & Replace in Kombination mit Offset probiert, aber bisher ohne Erfolg
Wer kann mir weiterhelfen?

[Toxitom]

Hey okabambu,

also, da wirst wohl um Schleifen nicht herumkommen.
Frage: Wie gut kennst Du dich mit Makros in LO/AOO aus, wie weit ist Dir das API Modell bekannt?

Der Weg wäre:
- Schleife über alle Tabellenblätter
- Schleife über alle benutzten Zellen der Spalte C
- Prüfen, ob Suchbedingung erfüllt - wenn ja, dann Änderung des Wertes der Spalte "D"

Je mehr feste Grenzen Du definieren kannst - um so besser aber Schleifen werden Ihre Zeit brauchen. Schätze aber, Performace (also Zeit) ist nicht das Problem;)

Also - leg los. Poste Deinen Code, den Du dann schon hinbekommen hast und wir helfen gerne bei der Korrektur bzw. bei Fragen

Viele Grüße
Tom

[okabambu]

Hallo,

ich habe inzwischen Makro-Code zusammengebastelt.
Soweit scheint es zu funktionieren.
Zusätzlich werden auch die Zellen gelb markiert welche vom Makro automatisch geändert wurden.

Code: Alles auswählen

Sub DivideByTwo
 Dim oDoc As Object
 oDoc = ThisComponent
 Dim oSheet As Object
 Dim i As Integer
 For i = 0 To oDoc.getSheets.getCount() - 1
    oSheet = oDoc.getSheets.getByIndex(i)
    Dim oCell As Object
    Dim sSearch As String

   

oSearchDescriptor = oSheet.createSearchDescriptor
          oSearchDescriptor.SearchString = "ABC"
          oCell = oSheet.FindFirst( oSearchDescriptor )
      



    oCell = oSheet.findFirst(oSearchDescriptor, False, False, False, False, False, False, False, False)


    If Not IsNull(oCell) Then
        Dim oCellD As Object
        oCellD = oSheet.getCellByPosition(oCell.CellAddress.Column + 1, oCell.CellAddress.Row)
        Dim oldValue As Double
        oldValue = oCellD.getValue()
        oCellD.setValue(oldValue / 2)
        If oCellD.getValue() <> oldValue Then
            oCellD.CellBackColor = RGB(255, 255, 0) ' Set the background color to yellow
        End If
    End If
 Next i
End Sub