Inhalt einer Zelle in eine andere kopieren, wenn...

[mostpatiently]

Hallo zusammen,
ich habe folgendes Problem: In Calc habe ich drei Spalten a, b, c. In Spalte A sind Namen, die beiden anderen Spalten sind vorerst leer. Nun möchte ich, dass, wenn beispielsweise in Zelle B2 Text geschrieben wird, dann automatisch der Text aus Zelle A2 in die Spalte C copiert wird. Dabei soll berücksichtigt werden, wenn in Spalte C schon Zellen belegt sind, dass dann der Inhalt aus Zelle A2 automatisch in der nächsten freien Zelle in Spalte C landet.

Ich hoffe, jemand kann mir helfen

Danke

[peterschleif]

Hallo.

Du müsstest zur Spalte B deiner Tabelle einen ModifyListener hinzufügen, der Änderungen an der Spalte registriert und dann entsprechend reagiert. Der Listener wird am besten beim Öffnen des Dokuments hinzugefügt und beim Schließen wieder entfernt. Dazu muss man den beiden Ereignissen "Dokument öffnen" bzw. "Dokument schließen" die beiden betreffenden Makros zuweisen. Das wurde erst gestern hier erklärt:

viewtopic.php?f=18&t=31377#p125333

Die beiden Makros findest Du im Code unten: AddListener() und RemoveListener(). Anschließend speichern, schließen und wieder öffnen.

Nun wird bei jeder Änderung in Spalte B die Prozedur Change_modified() aufgerufen. Die überträgt den Wert aus Spalte A der gleichen Zeile in Spalte C. Dabei wird beginnend in Zelle [C1] nach unten nach der nächsten freien Zelle gesucht. Oder wolltest Du die Suche in der gleichen Zeile beginnen in der auch die Änderung gemacht wurde? Das ging aus deinem Text nicht eindeutig hervor.

Den Namen der überwachten Tabelle müsstest Du noch anpassen. Zur Zeit ist es "Tabelle1". Du findest ihn in der Const-Anweisung ziemlich weit oben im Code.

Peter

Code: Alles auswählen

Option Explicit

Global oRange
Global oListener

Const TABELLE = "Tabelle1"
 
Sub AddListener()
    oListener = CreateUnoListener("Change_", "com.sun.star.util.XModifyListener")
    oRange    = ThisComponent.Sheets(TABELLE).Columns.GetByIndex(1)
    oRange.addModifyListener(oListener)
End Sub
 
Sub RemoveListener()
    On Error Resume Next
    oRange.removeModifyListener(oListener)
End Sub
 
Sub Change_modified(aEvent)
    Dim oCell  As Object
    Dim oSheet As Object
    Dim iRow   As Long

    oCell  = ThisComponent.CurrentSelection.getCellByPosition(0, 0)
    oSheet = oCell.SpreadSheet
    iRow   = oCell.RangeAddress.StartRow

    For iRow = 0 To oSheet.Rows.Count - 1
        If oSheet.getCellByPosition(2, iRow).Formula = "" Then
            oSheet.getCellByPosition(2, iRow).Formula = oSheet.getCellByPosition(0, oCell.RangeAddress.StartRow).Formula
            Exit For
        End If
    Next
End Sub