Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
812to816
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
812to816
812to816
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Hinzufügen von Werten mittels Makro

Hinzufügen von Werten mittels Makro
01.11.2006 11:11:35
Werten
Hallo zusammen,
ich habe folgendes Problem! Vielleicht kann mir jemand weiterhelfen?!
In der angehängten Tabelle befinden sich zwei Tabellenblätter. Auf Tabellenblatt 1 gibt Abteilung 1 Werte in dem dafür definierten Bereich ein.
Abteilung 2 sucht auf dem Tabellenblatt 2 mit dem Bezug die Werte aus Abteilung 1. Jetzt soll Abteilung 2 seine Werte hinzufügen und mittels Makro sollen diese Werte dann in das Tabellenblatt 1 übertragen werden.
Ist sowas möglich, kann mir jemand dabei helfen?
https://www.herber.de/bbs/user/37824.xls
Gruß

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
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


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige