Re: Werte verbinden
23.06.2002 12:47:15
Ramses
Hallo Rolf,auch wenn mein Namensvetter schon geantwortet und eine Lösung hat,... hier eine Lösung für deine beiden Probleme:
'Diesen Code in die Tabelle kopieren wo diese Funktion gültig sein soll
Private Sub Worksheet_Change(ByVal Target As Range)
'------------
'Erhöht den Zähler in Spalte A
'------------
'Das Makro funktioniert erst ab zeile 3 !!
'Ansonsten wäre es etwas aufwändiger
'Abbrechen wenn nicht Spalte D
If Target.Column <> 4 Or Target.Row < 3 Then Exit Sub
'Wenn in der vorhergehenden Zeile keine Nummer steht
'wird das Makro abgebrochen
If Cells(Target.Row - 1, 1) = "" Then
MsgBox "Der Wert wurde an falscher Stelle eingefügt" & vbCrLf & "Keine fortlaufende Nummerierung möglich"
Exit Sub
'Wenn der Wert aus der zu addierenden Zelle keine Nummer ist
'wird das Makro abgebrochen
ElseIf Not IsNumeric(Cells(Target.Row - 1, 1)) Then
MsgBox "Der zu addierende Wert in " & Cells(Target.Row - 1, 1).Address & " ist keine Zahl" & vbCrLf & "Keine fortlaufende Nummerierung möglich"
Exit Sub
'Wenn bereits ein Wert in der gleichen zeile in Spalte A steht
'wird das Makro abgebrochen
ElseIf Cells(Target.Row, 1) <> "" Then
MsgBox "Der Wert wurde im Datenbereich eingefügt" & vbCrLf & "Keine neue Nummerierung möglich"
Exit Sub
End If
'der Wert wird um 1 erhöht
Cells(Target.Row, 1) = Cells(Target.Row - 1, 1) + 1
End Sub
'Diesen in ein Modul kopieren und über eine Schaltfläche oder über
'Extras - Makros - Makro ausführen" aufrufen
Sub Combine_CellValues()
'Die Ausführung dieses codes überprüft alle Zellen in
'spalte I und Spalte L, anschliessend werden alle Zellinhalte
'in Spalte M geschrieben
Dim Cr As Long, Cr1 As Long, Cr2 As Long
Cr = 65536
'Letzten Eintrag in Spalte I suchen
If Cells(Cr, 9) = "" Then
Cr1 = Cells(Cr, 9).End(xlUp).Row
Else
Cr1 = Cr
End If
'Letzten Eintrag in Spalte L suchen
If Cells(Cr, 12) = "" Then
Cr2 = Cells(Cr, 12).End(xlUp).Row
Else
Cr2 = Cr
End If
'Den wirklich letzten Eintrag suchen
If Cr1 < Cr2 Then
Cr = Cr2
ElseIf Cr1 > Cr2 Then
Cr = Cr1
ElseIf Cr1 = Cr2 Then
Cr = Cr1
End If
'Das vergleichen der Werte beginnt in Zeile 2
For i = 2 To Cr
'Wenn eine der Zellen leer ist, wird nichts in M geschrieben
If Not IsEmpty(Cells(i, 9)) And Not IsEmpty(Cells(i, 12)) Then
'beide Zellen haben einen Inhalt, dann wird der Wert geschrieben
Cells(i, 13) = Cells(i, 9) & Cells(i, 12)
End If
Next i
End Sub
Code eingefügt mit Syntaxhighlighter 1.12