AW: Hinzufügen von Werten mittels Makro
01.11.2006 21:03:56
Werten
Hallo Sven,
folgende Makros übertragen die Eingaben in den Spalten 5 und 6 in die entsprechende Zeilen der Tabelle1, wenn in Spalte A korrekte Eingaben für Bezug gemacht sind.
Das 1. Makro muss du im VBA-Editor (Aufrufen mit Tasten Alt+F11) unter der Tabelle2 einfügen. Das 2. Makro in einem allgemeinen Modul oder unter einer Tabelle
Das 1. Makro überträgt jeden in Spalte 5 oder 6 der Tabelle2 eingegeben Wert sofort in die Tabelle1.
Das 2. Makro überträgt die Werte nach manuellem Start des Makros.
Gruss
Franz
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim wks As Worksheet, Suchen As Variant, Bereich As Range, Zelle1 As Range, Zelle2 As Range
Set wks = Worksheets("Tabelle1")
With wks
Set Bereich = .Range(.Cells(3, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
If Target.Column = 5 Or Target.Column = 6 And Target.Columns.Count <= 2 And Target.Row >= 3 Then
For Each Zelle2 In Target
Suchen = Me.Cells(Zelle2.Row, "A")
Set Zelle1 = Bereich.Find(what:=Suchen, LookIn:=xlValues)
If Zelle1 Is Nothing Then
MsgBox "Wert in Spalte A, Zeile " & Zelle2.Row & " ist in Tabelle1 nicht vorhanden"
Else
Zelle1.Offset(0, Zelle2.Column - 1).Value = Zelle2.Value
End If
Next
End If
End Sub
Sub Wertevon2nach1()
Dim wks1 As Worksheet, wks2 As Worksheet, Suchen As Variant, Bereich As Range, Zelle1 As Range, Zelle2 As Range
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
With wks1
Set Bereich = .Range(.Cells(3, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
With wks2
For Each Zelle2 In .Range(.Cells(3, 5), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 6))
Suchen = .Cells(Zelle2.Row, "A")
Set Zelle1 = Bereich.Find(what:=Suchen, LookIn:=xlValues)
If Zelle1 Is Nothing Then
MsgBox "Wert in Spalte A, Zeile " & Zelle2.Row & " ist in Tabelle1 nicht vorhanden"
Else
Zelle1.Offset(0, Zelle2.Column - 1).Value = Zelle2.Value
End If
Next
End With
End Sub