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

VBA Problem

VBA Problem
16.07.2007 08:13:00
Josef
Hallo!
Wenn ich im Arbeitsblatt 2 in der Spalte G in der nächsten freien Zelle einen Wert eingebe, so werden in dieser Zeile in den Spalten A-F und H - die dazugehörigen Werte mittels einer Formel ergänzt.
nun möchte ich erreichen dass wenn ich über das Worksheet_Change Ereignis in der Spalte G diesen Wert eingebe, die Werte von der Spalte A bis F sowie H - I im Arbeitsblatt "Tabelle1" in der nächsten freien Zeile eingetragen werden.
Arbeitsblatt 2 Spalte A = Arbeitsblatt 1 Spalte D
Arbeitsblatt 2 Spalte B+C = Arbeitsblatt 1 Spalte E
Arbeitsblatt 2 Spalte D = Arbeitsblatt 1 Spalte F
Arbeitsblatt 2 Spalte E+F = Arbeitsblatt 1 Spalte F
Arbeitsblatt 2 Spalte G = Arbeitsblatt 1 Spalte H
Arbeitsblatt 2 Spalte H+1 = Arbeitsblatt 1 Spalte I
Im Grossen und Ganzen würde ja alles funktionieren.
nur wenn das Ereignis ausgelöst wird werden die Werte nicht in die Tabelle1 kopiert, wahrscheinlich auf Grund der Formel in der Tabelle2. Wenn ich jedoch die Zellen mit den Formeln öffne und bestätige, wird der Wert richtig in der Tabelle1 eingetragen.
Wie könnte man dieses Problem bitte vVBA mäßig umgehen?
Danke
Josef

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Problem
16.07.2007 08:19:00
Hajo_Zi
Hallo Josef,
das liest sich so als ob Du schon Code hast? Ich lehne es ab über das Internet auf fremde Rechner zu schauen. Welchen Grund sollte ich auch haben Deine Datei nochmal nachzubauen, Du hast die Zeit doch schon investiert?

AW: VBA Problem
16.07.2007 08:36:56
Josef
Hallo Hajo!
Danke für Deine Antwort!
Habe gerade eine Musterdatei zusammengestellt. Leider ist jedoch nur eine Größe von 528 KB das Minimum das ich erreiche. Daher kann ich diese Datei nicht hochladen, da ja nur 300 KB erlaubt sind.
Josef

AW: VBA Problem
16.07.2007 08:45:14
Hajo_Zi
Hallo Josef,
ich habe mal gelesen es soll auch ein Programm ZIP geben damt kann man die Datei komprimieren. Ab Betriebssystem XP ist es schon inclusive. Man sollte in der Datei auch nur das ablegen was für das Problem relevant ist. Es müssen nicht zig hundert Datensätze sein.
Gruß Hajo

Anzeige
Upload geschafft
16.07.2007 08:46:19
Josef
Hallo Hajo!
Habe es jetzt geschafft. Da hat es Verknüpfungen gegeben, die mußte ich noch löschen
Hier ist die Musterdatei:
https://www.herber.de/bbs/user/44110.xls
Josef

AW: Upload geschafft
16.07.2007 09:04:00
Hajo_Zi
Hallo Josef,
ich hätte den Code vielleicht ein wenig anders geschrieben.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim efz As Long, k As Range
Application.EnableEvents = False
If Target.Column = 7 And Target.Row > 2 Then
If Target.Count = 1 Then
r = Target.Row - 1
Range(Cells(r, 1), Cells(r, 6)).Copy _
Range(Cells(r + 1, 1), Cells(r + 1, 6))
Range(Cells(r, 8), Cells(r, 9)).Copy _
Range(Cells(r + 1, 8), Cells(r + 1, 9))
End If
ElseIf Target.Row > 1 Then
With Worksheets("tabelle1")
Select Case Target.Column
Case 1
Set k = .Columns(104).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 4).Value = Target
Else
efz = .Cells(Rows.Count, 4).End(xlUp).Row + 1
.Cells(efz, 4).Value = Target
.Cells(efz, 104).Value = Target.Row
End If
Case 2
Set k = .Columns(110).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 5).Value = Target
Else
efz = .Cells(Rows.Count, 5).End(xlUp).Row + 1
.Cells(efz, 5).Value = Target & " - " & Target.Offset(0, 1)
'.Cells(efz, 5).Value = Target
.Cells(efz, 110).Value = Target.Row
End If
Case 4
Set k = .Columns(105).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 6).Value = Target
Else
efz = .Cells(Rows.Count, 6).End(xlUp).Row + 1
.Cells(efz, 6).Value = Target
.Cells(efz, 105).Value = Target.Row
End If
Case 5
Set k = .Columns(111).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 7).Value = Target
Else
efz = .Cells(Rows.Count, 7).End(xlUp).Row + 1
.Cells(efz, 7).Value = Target & " " & Target.Offset(0, 1)
'.Cells(efz, 5).Value = Target
.Cells(efz, 111).Value = Target.Row
End If
Case 7
Set k = .Columns(106).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 8).Value = Target
Else
efz = .Cells(Rows.Count, 8).End(xlUp).Row + 1
.Cells(efz, 8).Value = Target
.Cells(efz, 106).Value = Target.Row
End If
Case 8
Set k = .Columns(112).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 9).Value = Target
Else
efz = .Cells(Rows.Count, 9).End(xlUp).Row + 1
.Cells(efz, 9).Value = Target & " " & Target.Offset(0, 1)
'.Cells(efz, 5).Value = Target
.Cells(efz, 112).Value = Target.Row
End If
End Select
End With
End If
Set k = Nothing
Application.EnableEvents = True
End Sub


Was muss ich jetzt machen nd wo steht was nicht richtig?
Gruß Hajo

Anzeige
AW: Upload geschafft
16.07.2007 09:24:46
Josef
Hallo Hajo!
Danke für Deine Antwort!
Habe jetzt den Code mit den folgenden Zeilen (siehe ' ) ergänzt.
Leider passiert jetzt gar nuichts mehr. Es wird keine Aktion durchgeführt. Wo hhabe ich bitte den Fehler gemacht?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long, wsB As Worksheet, wsC As Worksheet
Dim efz As Long, k As Range
Application.EnableEvents = False
If Target.Column = 7 And Target.Row > 1 Then
If Target.Count = 1 Then
'Set wsB = Sheets("Lotus Notes")
'Set wsC = Sheets("Binf neu (2)")
r = Target.Row - 1
Range(Cells(r, 1), Cells(r, 6)).Copy _
Range(Cells(r + 1, 1), Cells(r + 1, 6))
'   wsB.Range(wsB.Cells(r, 1), wsB.Cells(r, 6)).Copy _
'   wsB.Range(wsB.Cells(r + 1, 1), wsB.Cells(r + 1, 6))
'   wsC.Range(wsC.Cells(r, 1), wsC.Cells(r, 9)).Copy _
'   wsC.Range(wsC.Cells(r + 1, 1), wsC.Cells(r + 1, 9))
Range(Cells(r, 8), Cells(r, 9)).Copy _
Range(Cells(r + 1, 8), Cells(r + 1, 9))
'   wsB.Range(wsB.Cells(r, 7), wsB.Cells(r, 12)).Copy _
wsB.Range(wsB.Cells(r + 1, 7), wsB.Cells(r + 1, 12))
'  wsC.Range(wsC.Cells(r, 22), wsC.Cells(r, 26)).Copy _
wsC.Range(wsC.Cells(r + 1, 22), wsC.Cells(r + 1, 26))
'   Set wsB = Nothing
'   Set wsC = Nothing
End If
'End If
ElseIf Target.Row > 1 Then
With Worksheets("tabelle1")
Select Case Target.Column
Case 1
Set k = .Columns(104).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 4).Value = Target
Else
efz = .Cells(Rows.Count, 4).End(xlUp).Row + 1
.Cells(efz, 4).Value = Target
.Cells(efz, 104).Value = Target.Row
End If
Case 2
Set k = .Columns(110).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 5).Value = Target
Else
efz = .Cells(Rows.Count, 5).End(xlUp).Row + 1
.Cells(efz, 5).Value = Target & " - " & Target.Offset(0, 1)
'.Cells(efz, 5).Value = Target
.Cells(efz, 110).Value = Target.Row
End If
Case 4
Set k = .Columns(105).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 6).Value = Target
Else
efz = .Cells(Rows.Count, 6).End(xlUp).Row + 1
.Cells(efz, 6).Value = Target
.Cells(efz, 105).Value = Target.Row
End If
Case 5
Set k = .Columns(111).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 7).Value = Target
Else
efz = .Cells(Rows.Count, 7).End(xlUp).Row + 1
.Cells(efz, 7).Value = Target & " " & Target.Offset(0, 1)
'.Cells(efz, 5).Value = Target
.Cells(efz, 111).Value = Target.Row
End If
Case 7
Set k = .Columns(106).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 8).Value = Target
Else
efz = .Cells(Rows.Count, 8).End(xlUp).Row + 1
.Cells(efz, 8).Value = Target
.Cells(efz, 106).Value = Target.Row
End If
Case 8
Set k = .Columns(112).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 9).Value = Target
Else
efz = .Cells(Rows.Count, 9).End(xlUp).Row + 1
.Cells(efz, 9).Value = Target & " " & Target.Offset(0, 1)
'.Cells(efz, 5).Value = Target
.Cells(efz, 112).Value = Target.Row
End If
End Select
End With
End If
Set k = Nothing
Application.EnableEvents = True
End Sub


Anzeige
AW: Upload geschafft
16.07.2007 09:31:40
Hajo_Zi
Hallo Josef,
wozu sind auskommentierte Zeilen im Code gut?
Beschreibe doch mal was der Code machen sollte. Also mein Code macht was.
Gruß Hajo

AW: Upload geschafft
16.07.2007 09:48:35
Hajo_Zi
Hallo Josef,
auskommentierter Code wird in meinen Excelversionen grundsätzlich nicht ausgeführt. Mir scheint aber wir sprechen aneinander vorbei. Ich lasse den Beitrag mal offen, es kann sich der nächste versuchen.
Gruß Hajo

Das ist mir schon klar......
16.07.2007 09:59:04
Josef
Hallo Hajo!
zu
auskommentierter Code wird in meinen Excelversionen grundsätzlich nicht ausgeführt.
Ich meinte ja nicht das der auskommentierte code ausgeführt wird. Das ist mir schon klar, das das nicht funktionieren kann.
Dein Lösungsvorschlag würde ja im Großen und Ganzen bestens funktionieren.
Das was jetzt noch nicht funktioniert, ist der Eintrag in der Spalte 7 sowie die Automatisierung.
Ich bin auf jeden Fall für Deine Hilfe und Deine Mühe sehr dankbar.
Josef

Anzeige
AW: Das ist mir schon klar......
Orakel
Hallo,
sorry Josef, da man hier ja sonst keinen Dampf ablassen kann:
Warum traut sich hier eigentlich keiner mal das auszusprechen, was Hajo in diesem Forum veranstaltet? Nach seinem letzten Abschied aus diesem Forum kehrte lange Zeit Ruhe ein. Er praktiziert mit seinen abwertenden Standardkommentaren menschenverachtenden Zsynismus und das schon unzählige Monate. Ich weiß nicht, was einen Menschen dazu treibt unaufhörlich Andere nieder zu machen, sich als Leuchte und Herr über jeden und alles zu stellen anstatt etwas zur Sache beizutragen.
Keine gute Reklame für dieses Forum!
Und jetzt darf es mal wieder eine Ermahnung mit Androhung von Konsequenzen an mich sein.
Danke, - Orakel
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige