Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
140to144
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
140to144
140to144
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zellen auf versch. Blättern abgleichen/editieren

Zellen auf versch. Blättern abgleichen/editieren
30.07.2002 15:38:50
Jan L.
Hallo zusammen,

ich habe folgendes Problem:

Ich habe für verschiedene Produkte eine Lagerliste mit der Anzahl der vorhandenen Einzelteile die zur Montage dieses Teils benötigt werden erstellt. Dabei gibt es auch Einzelteile, die für mehrere Produkte gleich sind. Gibt es eine Möglichkeit, per VBA oder wie auch immer die Tabelle so zu gestallten, daß es egal ist in welchem Tabellenblatt ich die Anzahl ändere? Der aktuelle Bestand soll dann in den anderen Blättern automatisch übernommen werden.
Ist es weiterhin möglich, daß wenn ich die Anzahl ändere, danach in einer benachbarten Spalte automatisch das Änderungsdatum eingetragen wird?

MfG

Jan L.

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Zellen auf versch. Blättern abgleichen/editieren
30.07.2002 16:05:07
Mike E.
Hallo,

dazu eine UserForm mit zwei Textfeldern und zwei CommandButtons erstellen:

TextBox1= txt1
TextBox2 = txt2

dem ersten CommandButton folgenden Code zuweisen:

Sheets("Tabelle1").Activate
Cells.Find(What:=txt1, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate

ActiveCell(1, 2).Select
Selection = txt2

Sheets("Tabelle2").Activate
Cells.Find(What:=txt1, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate

ActiveCell(1, 2).Select
Selection = txt2

Sheets("Tabelle3").Activate
Cells.Find(What:=txt1, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate

ActiveCell(1, 2).Select
Selection = txt2

Dem zeiten CommandButton "Unload Me" zuweisen.

In das erste Textfeld gibst du den Suchbegriff ein, in das zweite Feld die Artikel Anzahl.

Gruß
Mike

Anzeige
Re: Zellen auf versch. Blättern abgleichen/editieren
30.07.2002 16:12:33
Mike E.
Hallo,

habe die Frage nach dem Datum vergessen:

jeweils unter
ActiceCell(1,2) = txt2

folgenden Befehl:

ActiveCell(1,2) = Date
(bewirkt, dass rechts von der neue´n Anzahl an Artikeln das Datum eingefügt wird - in vorher genanntem Code mußt du das also dreimal dazuschreiben!)


Gruß
Mike

Re: Zellen auf versch. Blättern abgleichen/editieren
30.07.2002 16:23:23
Jan L.
Danke Mike,

gibt es auch eine Möglichkeit, diesen Code automatisch auszuführen, wenn ich den Inhalt in einer Zelle in Excel manuell ändere, d.h. ohne die Daten in ein Userform einzugeben? Die eindeutige Zeichnungsnummer des Einzelteils liegt eine Spalte links neben Anzahl.

Gruß

Jan

Anzeige
Re: Zellen auf versch. Blättern abgleichen/editieren
30.07.2002 16:27:50
Mike E.
Hallo,

auf die schnelle fällt mit da nur die Worksheet_Change oder _Calculate-Methode ein.

Der Code würde dann ähnlich aussehen.

Ich werde mich morgen erneut melden.

Gruß
Mike

Re: Zellen auf versch. Blättern abgleichen/editieren
30.07.2002 22:47:25
Mike E.
Hallo Jan,

ich habe mir noch einmal Gedanken gemacht...

Folgendes Beispiel arbeitet mit dem rechten Mausklick auf eine Zelle in "Tabelle1".
Ich nehme an, das soll bei dir über alle Tabellen funktionieren. Dann musst du diesen Code jeweils der entsprechenden tabelle zuweisen. Wenn du nicht weißt, wie das geht, dann melde dich nochmal.

Ich habe den Code jetzt allerdings für eine Artikelbezeichung links neben der Anzahl gechrieben. In deinem Fall musst du jeweils die zweite Zahl hinter "activecell" ändern. Falls unverständlich, dann paase ich den Code gerne nochmal an:

Private Sub Worksheet_BeforerightClick(ByVal Target As Range, Cancel As Boolean)

'gewünschten Zellwert in Tabelle1 ändern, dann rechte Maustaste betätigen
Selection.Activate
Selection.Copy 'kopiert den Wert der Zelle
ActiveCell(1, -1).Select
ActiveCell(1, 2).Select 'wählt die Zelle mit dem Artikl aus
i = Selection ' i ist der Artikel (deine Ware)

'übertägt Wert und Datum in Tabelle2
Sheets("Tabelle2").Activate
Sheets("tabelle2").Cells.Find(What:=i, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell(1, 2).Select
ActiveSheet.Paste
ActiveCell(1, 2) = Date

'übertägt Wert und Datum in Tabelle3
Sheets("Tabelle3").Activate
Sheets("Tabelle3").Cells.Find(What:=i, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell(1, 2).Select
ActiveSheet.Paste
ActiveCell(1, 2) = Date

'kehrt auf das Ursprungsblatt zurück und versieht die neue eingabe mit dem Tagesdatum
Sheets("Tabelle1").Activate
ActiveCell(1, 3) = Date
End Sub

ich hoffe das hilft.

Gruß
Mike

Anzeige
Re: Zellen auf versch. Blättern abgleichen/editieren
31.07.2002 12:23:39
Jan L.
Vielen Dank für die Denkanstösse,

die Prozedur sieht jetzt für jedes Blatt so aus

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const spalteBestand = 4 'Anzahl steht in Spalte 4 = "D"
Dim ZeichNr
Dim zelle
Dim sheetnr As Integer
Dim i As Integer
If running Then Exit Sub 'Variable zur Vermeidung von Endlos-Schleifen - als Global Boolean in Modul deklariert
running = True
On Error Resume Next
If Target.Column = spalteBestand And Target.Row > 1 Then 'Ausführung nur, wenn spalteBestand verändert wurde
If Target.Comment.Text = "" Then 'für identische Bauteile muß irdgendein Kommentar eingefügt sein
'Bauteil nur einmal vorhanden
Err.Clear
On Error GoTo 0
Target.Range("b1").Select 'eine Spalte nach rechts
ActiveCell.Value = Date 'datum einfügen
Target.Range("a2").Select
running = False
Exit Sub
Else
'Bauteil mehrmals vorhanden
Err.Clear
On Error GoTo 0
Target.Range("a1").Select 'geänderte Zelle anwählen
Selection.Activate
Selection.Copy
ActiveCell(1, -1).Select
ActiveCell(1, 2).Select 'ZeichnungsNummer wählen
ZeichNr = Selection 'ZeichnungsNummer lesen
sheetnr = ActiveSheet.Index
For i = 1 To 4 'alle 4 Blätter durchsuchen
If i <> sheetnr Then 'ursprüngliches Blatt auslassen
Sheets(i).Select
Set zelle = Sheets(i).Cells.Find(What:=ZeichNr, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False) 'Zelle mit ZeichnungsNr suchen
If Not zelle Is Nothing Then 'nur falls Teil vorhanden ist
zelle.Activate
ActiveCell(1, 2).Select
ActiveSheet.Paste 'Bestand aktualisieren
ActiveCell(1, 2) = Date 'Datum aktualisieren
End If
End If
next_sheet:
Next i
Sheets(sheetnr).Select 'ursprüngliches Blatt anwählen
ActiveCell(1, 3) = Date 'Datum aktualisieren
Application.CutCopyMode = False
Target.Range("a2").Select
End If
End If
running = False
End Sub

Gruß
Jan

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige