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

Aufgerufene Daten in die Zeile zurückschreiben

Aufgerufene Daten in die Zeile zurückschreiben
09.05.2006 20:20:56
Wolfgang
Hallo liebe Excel-Freunde
ich hab da folgendes Problem mit einem Makro:
as 1. Makro ruft die Daten aus dem Tabelle "DATA" durch Auswahl eines Wertes sprich eines Textes der Zelle "B1" oder "C1" mit Hilfe eines Dropdownfeld auf und schreibt diese
Daten in die Tabelle "Datenblatt".
Hier möchte ich gerne die Änderungen der Daten vornehmen und dann per Button
die Daten in die richtige Zeile der Tabelle "DATA" zurückschreiben.
Das untere Makro schreibt die Daten in eine neue Zeile der Tabelle "DATA".
Meine Frage kann mir jemand vielleicht dieses Makro umschreiben so das die
geänderten Daten in die richtige Zeile der Tabelle "DATA" geschrieben werden?
ich hoffe auf Eure Hilfe
Gruß Wolfgang
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SuBe As Range, s As String
Application.ScreenUpdating = False
On Error GoTo Fehler
If Target.Value = "" Then Exit Sub 'Call
Datenblatt_Ohne_nachfrage_löschen '
s = Target.Text
Select Case Target.Address(0, 0)
Case "B1"
Call Objekt_Nr_Daten_Suchen
Set SuBe = wks1.Range("A2:A1000").Find(What:=s, _
After:=wks1.Range("A1000"), Lookat:=xlWhole)
Case "C1"
Set SuBe = wks1.Range("B2:B1000").Find(What:=s, _
After:=wks1.Range("B1000"), Lookat:=xlWhole)
Case Else: Exit Sub
End Select
If Not SuBe Is Nothing Then
Application.EnableEvents = False
Range("B1").Value = wks1.Range("A" & SuBe.Row).Value
Range("C1").Value = wks1.Range("B" & SuBe.Row).Value
Range("L1").Value = wks1.Range("C" & SuBe.Row).Value
Range("C2").Value = wks1.Range("D" & SuBe.Row).Value
Range("F2").Value = wks1.Range("E" & SuBe.Row).Value
Range("H2").Value = wks1.Range("F" & SuBe.Row).Value
Range("L2").Value = wks1.Range("G" & SuBe.Row).Value
Range("C3").Value = wks1.Range("H" & SuBe.Row).Value
Range("H3").Value = wks1.Range("I" & SuBe.Row).Value
Range("C6").Value = wks1.Range("J" & SuBe.Row).Value
Range("E6").Value = wks1.Range("K" & SuBe.Row).Value
Range("H6").Value = wks1.Range("L" & SuBe.Row).Value
Range("J6").Value = wks1.Range("M" & SuBe.Row).Value
Range("L6").Value = wks1.Range("N" & SuBe.Row).Value
Range("C7").Value = wks1.Range("P" & SuBe.Row).Value
Range("E7").Value = wks1.Range("Q" & SuBe.Row).Value
Range("H7").Value = wks1.Range("R" & SuBe.Row).Value
Range("J7").Value = wks1.Range("S" & SuBe.Row).Value
Range("L7").Value = wks1.Range("T" & SuBe.Row).Value
Range("C8").Value = wks1.Range("U" & SuBe.Row).Value
Range("E8").Value = wks1.Range("V" & SuBe.Row).Value
Range("H8").Value = wks1.Range("W" & SuBe.Row).Value
Range("J8").Value = wks1.Range("X" & SuBe.Row).Value
Range("L8").Value = wks1.Range("Y" & SuBe.Row).Value
Range("C9").Value = wks1.Range("Z" & SuBe.Row).Value
Range("E9").Value = wks1.Range("AA" & SuBe.Row).Value
Range("H9").Value = wks1.Range("AB" & SuBe.Row).Value
Range("J9").Value = wks1.Range("AC" & SuBe.Row).Value
Range("L9").Value = wks1.Range("AD" & SuBe.Row).Value
Range("C10").Value = wks1.Range("AE" & SuBe.Row).Value
Range("E10").Value = wks1.Range("AF" & SuBe.Row).Value
Range("H10").Value = wks1.Range("AG" & SuBe.Row).Value
Range("J10").Value = wks1.Range("AH" & SuBe.Row).Value
Range("L10").Value = wks1.Range("AI" & SuBe.Row).Value
Range("C12").Value = wks1.Range("AK" & SuBe.Row).Value
Range("C14").Value = wks1.Range("AL" & SuBe.Row).Value
Range("C15").Value = wks1.Range("AM" & SuBe.Row).Value
Range("C16").Value = wks1.Range("AN" & SuBe.Row).Value
Range("C17").Value = wks1.Range("AO" & SuBe.Row).Value
Range("C18").Value = wks1.Range("AP" & SuBe.Row).Value
Range("C19").Value = wks1.Range("AQ" & SuBe.Row).Value
Range("C20").Value = wks1.Range("AR" & SuBe.Row).Value
Range("C21").Value = wks1.Range("AS" & SuBe.Row).Value
Range("C22").Value = wks1.Range("AT" & SuBe.Row).Value
Range("C23").Value = wks1.Range("AU" & SuBe.Row).Value
Range("C24").Value = wks1.Range("AV" & SuBe.Row).Value
Range("C25").Value = wks1.Range("AW" & SuBe.Row).Value
Range("C26").Value = wks1.Range("AX" & SuBe.Row).Value
Range("A30").Value = wks1.Range("AY" & SuBe.Row).Value
Range("B30").Value = wks1.Range("AZ" & SuBe.Row).Value
Range("B31").Value = wks1.Range("BA" & SuBe.Row).Value
Range("B32").Value = wks1.Range("BB" & SuBe.Row).Value
Range("E30").Value = wks1.Range("BD" & SuBe.Row).Value
Range("E31").Value = wks1.Range("BE" & SuBe.Row).Value
Range("E32").Value = wks1.Range("BF" & SuBe.Row).Value
Range("G30").Value = wks1.Range("BG" & SuBe.Row).Value
Range("G31").Value = wks1.Range("BH" & SuBe.Row).Value
Range("G32").Value = wks1.Range("BI" & SuBe.Row).Value
Range("I30").Value = wks1.Range("BJ" & SuBe.Row).Value
Range("I31").Value = wks1.Range("BK" & SuBe.Row).Value
Range("I32").Value = wks1.Range("BL" & SuBe.Row).Value
Range("K30").Value = wks1.Range("BM" & SuBe.Row).Value
Range("K31").Value = wks1.Range("BN" & SuBe.Row).Value
Range("K32").Value = wks1.Range("BO" & SuBe.Row).Value
Range("M30").Value = wks1.Range("BP" & SuBe.Row).Value
Range("M31").Value = wks1.Range("BQ" & SuBe.Row).Value
Range("M32").Value = wks1.Range("BR" & SuBe.Row).Value
Range("N1").Value = wks1.Range("BS" & SuBe.Row).Value
Set SuBe = Nothing
Application.EnableEvents = True
Else
'            MsgBox "Suchbegriff: ' " & s & "  ' nicht gefunden !", 64, _
'            "Dezenter Hinweis für " & Application.UserName & ":"
If MsgBox("Suchbegriff:  ' " & s & " '  nicht gefunden !" _
& Chr(13) & "Soll der Inhalt des Datenblattes gelöscht werden ?",
_
vbQuestion + vbYesNo, "Hallo " & Application.UserName & ": " _
& "Inhalt des Datenblattes löschen ?") = vbYes Then
Call Datenblatt_Ohne_nachfrage_löschen
End If
End If
Application.ScreenUpdating = True
Fehler:
Exit Sub
End Sub

Dieses Marko schreibt die daten aus dem Datenblatt in die erste leere Zeile
im DATA Tabellenblatt!
Option Explicit
Sub Datenblatt_Werte_nach_DATA_Schreiben()
Dim c As Range, s As String, l As Integer, j As Long
If MsgBox("Soll der Inhalt des Datenblattes in die Datenbank eingegeben
werden ?" _
& Chr(13) & "Die Daten werden in der Datenbank automatisch nach Alphabet
einsortiert!", _
vbQuestion + vbYesNo, "Inhalt des Datenblattes nach DATA Einfügen und
Sortieren") = vbYes Then
s = "B1,C1,L1,C2,F2,H2,L2,C3,H3,C6,E6,H6,J6,L6,B1,C7,E7,H7,J7,L7,C8," _
& "E8,H8,J8,L8,C9,E9,H9,J9,L9,C10,E10,H10,J10,L10,B1,C12,C14,C15,C16," _
& "C17,C18,C19,C20,C21,C22,C23,C24,C25,C26,A30,B30,B31,B32,B1,E30," _
& "E31,E32,G30,G31,G32,I30,I31,I32,K30,K31,K32,M30,M31,M32,N1"
l = 1
With Tabelle2
j = wks1.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
For Each c In .Range(s)
wks1.Cells(j, l) = c
l = l + 1
Next c
End With
'Call Sortieren_nach_Firma_Aufwärts
End If
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Aufgerufene Daten in die Zeile zurückschreiben
10.05.2006 00:45:43
Franz
Hallo Wolfgang,
definiere am Beginn eines Moduls eine Variable für die Zeilennummer als Public
z.B.

Public Zeile as Long
Dieser Variablen weist du im 1. Makro den Zeilenwert zu
s = Target.Text
Select Case Target.Address(0, 0)
Case "B1"
Call Objekt_Nr_Daten_Suchen
Set SuBe = wks1.Range("A2:A1000").Find(What:=s, _
After:=wks1.Range("A1000"), Lookat:=xlWhole)
Zeile = SuBe.Row
Case "C1"
Set SuBe = wks1.Range("B2:B1000").Find(What:=s, _
After:=wks1.Range("B1000"), Lookat:=xlWhole)
Zeile = SuBe.Row
Case Else: Exit Sub
End Select
Im 2. Makro kannst du dann die Variable "Zeile" statt "j" verwenden.

Gruß
Franz
Anzeige
AW: Aufgerufene Daten in die Zeile zurückschreiben
10.05.2006 08:13:19
Wolfgang
Hallo Franz
ich danke Dir für Deine Antwort, werde die Lösung sobald wie möglich ausprobieren.
Melde mich dann wieder und sag Dir bescheid wie es geklappt hat.
Echt Prima von Dir.
vielen Dank
Gruß Wolfgang
AW: Aufgerufene Daten in die Zeile zurückschreiben
10.05.2006 12:02:21
Wolfgang
Hallo Franz,
habe gerade Deinen Tipp ausprobiert.
Leider muß ich sagen das es nicht funktioniert hat.
Ich bekomme eine Fehlermeldung.
Und "Zeile" hat den Wert 0.
Hast Du vieleicht Ahnung woran es liegen kann?
Gruß Wolfgang
AW: Aufgerufene Daten in die Zeile zurückschreiben
10.05.2006 16:22:48
Franz
Hallo Wolfgang,
Ferndiagnose ist schwierig.
Sind die beiden Makros in der gleichen Arbeitsmappe?
Falls Nein, dann funktioniert der von mir beschriebene Weg nicht. Dann muss du deine Makros anpassen und anders speichern/aufrufen.
Gruß
Franz
Anzeige
AW: Aufgerufene Daten in die Zeile zurückschreiben
11.05.2006 08:22:37
Wolfgang
Hallo Franz
Die Makros sind in einer Arbeitsmappe, allerdings in verschiedenen Modullen.
Kann es sein das durch das "Worksheet_Change" - Ereignis der Zeilenwert auf Null geht sobald ich eine Zellenwert verändere. Und kommt es deshalb zum Fehler?
Gruß Wolfgang
Anbei die geänderten Makros
Makro1:
Option Explicit
Public Zeile As Long

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SuBe As Range, s As String
Application.ScreenUpdating = False
On Error GoTo Fehler
If Target.Value = "" Then Exit Sub 'Call Datenblatt_Ohne_nachfrage_löschen '
s = Target.Text
Select Case Target.Address(0, 0)
Case "B1"
Call Objekt_Nr_Daten_Suchen
Set SuBe = wks1.Range("A2:A1000").Find(What:=s, _
After:=wks1.Range("A1000"), Lookat:=xlWhole)
Zeile = SuBe.Row
Case "C1"
Set SuBe = wks1.Range("B2:B1000").Find(What:=s, _
After:=wks1.Range("B1000"), Lookat:=xlWhole)
Zeile = SuBe.Row
Case Else: Exit Sub
End Select
If Not SuBe Is Nothing Then
Application.EnableEvents = False
Range("B1").Value = wks1.Range("A" & SuBe.Row).Value
Range("C1").Value = wks1.Range("B" & SuBe.Row).Value
Range("L1").Value = wks1.Range("C" & SuBe.Row).Value
Range("C2").Value = wks1.Range("D" & SuBe.Row).Value
Range("F2").Value = wks1.Range("E" & SuBe.Row).Value
Range("H2").Value = wks1.Range("F" & SuBe.Row).Value
Range("L2").Value = wks1.Range("G" & SuBe.Row).Value
Range("C3").Value = wks1.Range("H" & SuBe.Row).Value
Range("H3").Value = wks1.Range("I" & SuBe.Row).Value
Range("C6").Value = wks1.Range("J" & SuBe.Row).Value
Range("E6").Value = wks1.Range("K" & SuBe.Row).Value
Range("H6").Value = wks1.Range("L" & SuBe.Row).Value
Range("J6").Value = wks1.Range("M" & SuBe.Row).Value
Range("L6").Value = wks1.Range("N" & SuBe.Row).Value
Range("C7").Value = wks1.Range("P" & SuBe.Row).Value
Range("E7").Value = wks1.Range("Q" & SuBe.Row).Value
Range("H7").Value = wks1.Range("R" & SuBe.Row).Value
Range("J7").Value = wks1.Range("S" & SuBe.Row).Value
Range("L7").Value = wks1.Range("T" & SuBe.Row).Value
Range("C8").Value = wks1.Range("U" & SuBe.Row).Value
Range("E8").Value = wks1.Range("V" & SuBe.Row).Value
Range("H8").Value = wks1.Range("W" & SuBe.Row).Value
Range("J8").Value = wks1.Range("X" & SuBe.Row).Value
Range("L8").Value = wks1.Range("Y" & SuBe.Row).Value
Range("C9").Value = wks1.Range("Z" & SuBe.Row).Value
Range("E9").Value = wks1.Range("AA" & SuBe.Row).Value
Range("H9").Value = wks1.Range("AB" & SuBe.Row).Value
Range("J9").Value = wks1.Range("AC" & SuBe.Row).Value
Range("L9").Value = wks1.Range("AD" & SuBe.Row).Value
Range("C10").Value = wks1.Range("AE" & SuBe.Row).Value
Range("E10").Value = wks1.Range("AF" & SuBe.Row).Value
Range("H10").Value = wks1.Range("AG" & SuBe.Row).Value
Range("J10").Value = wks1.Range("AH" & SuBe.Row).Value
Range("L10").Value = wks1.Range("AI" & SuBe.Row).Value
Range("C12").Value = wks1.Range("AK" & SuBe.Row).Value
Range("C14").Value = wks1.Range("AL" & SuBe.Row).Value
Range("C15").Value = wks1.Range("AM" & SuBe.Row).Value
Range("C16").Value = wks1.Range("AN" & SuBe.Row).Value
Range("C17").Value = wks1.Range("AO" & SuBe.Row).Value
Range("C18").Value = wks1.Range("AP" & SuBe.Row).Value
Range("C19").Value = wks1.Range("AQ" & SuBe.Row).Value
Range("C20").Value = wks1.Range("AR" & SuBe.Row).Value
Range("C21").Value = wks1.Range("AS" & SuBe.Row).Value
Range("C22").Value = wks1.Range("AT" & SuBe.Row).Value
Range("C23").Value = wks1.Range("AU" & SuBe.Row).Value
Range("C24").Value = wks1.Range("AV" & SuBe.Row).Value
Range("C25").Value = wks1.Range("AW" & SuBe.Row).Value
Range("C26").Value = wks1.Range("AX" & SuBe.Row).Value
Range("A30").Value = wks1.Range("AY" & SuBe.Row).Value
Range("B30").Value = wks1.Range("AZ" & SuBe.Row).Value
Range("B31").Value = wks1.Range("BA" & SuBe.Row).Value
Range("B32").Value = wks1.Range("BB" & SuBe.Row).Value
Range("E30").Value = wks1.Range("BD" & SuBe.Row).Value
Range("E31").Value = wks1.Range("BE" & SuBe.Row).Value
Range("E32").Value = wks1.Range("BF" & SuBe.Row).Value
Range("G30").Value = wks1.Range("BG" & SuBe.Row).Value
Range("G31").Value = wks1.Range("BH" & SuBe.Row).Value
Range("G32").Value = wks1.Range("BI" & SuBe.Row).Value
Range("I30").Value = wks1.Range("BJ" & SuBe.Row).Value
Range("I31").Value = wks1.Range("BK" & SuBe.Row).Value
Range("I32").Value = wks1.Range("BL" & SuBe.Row).Value
Range("K30").Value = wks1.Range("BM" & SuBe.Row).Value
Range("K31").Value = wks1.Range("BN" & SuBe.Row).Value
Range("K32").Value = wks1.Range("BO" & SuBe.Row).Value
Range("M30").Value = wks1.Range("BP" & SuBe.Row).Value
Range("M31").Value = wks1.Range("BQ" & SuBe.Row).Value
Range("M32").Value = wks1.Range("BR" & SuBe.Row).Value
Range("N1").Value = wks1.Range("BS" & SuBe.Row).Value
Set SuBe = Nothing
Application.EnableEvents = True
Else
'            MsgBox "Suchbegriff: ' " & s & "  ' nicht gefunden !", 64, _
'            "Dezenter Hinweis für " & Application.UserName & ":"
If MsgBox("Suchbegriff:  ' " & s & " '  nicht gefunden !" _
& Chr(13) & "Soll der Inhalt des Datenblattes gelöscht werden ?", _
vbQuestion + vbYesNo, "Hallo " & Application.UserName & ": " _
& "Inhalt des Datenblattes löschen ?") = vbYes Then
Call Datenblatt_Ohne_nachfrage_löschen
End If
End If
Application.ScreenUpdating = True
Fehler:
Exit Sub
End Sub

Makro2:
Sub Datenblatt_Werte_nach_DATA_Schreiben()
Dim c As Range, s As String, l As Integer, j As Long
If MsgBox("Soll der Inhalt des Datenblattes in die Datenbank eingegeben werden ?" _
& Chr(13) & "Die Daten werden in der Datenbank automatisch nach Alphabet einsortiert!", _
vbQuestion + vbYesNo, "Inhalt des Datenblattes nach DATA Einfügen und Sortieren") = vbYes Then
s = "B1,C1,L1,C2,F2,H2,L2,C3,H3,C6,E6,H6,J6,L6,B1,C7,E7,H7,J7,L7,C8," _
& "E8,H8,J8,L8,C9,E9,H9,J9,L9,C10,E10,H10,J10,L10,B1,C12,C14,C15,C16," _
& "C17,C18,C19,C20,C21,C22,C23,C24,C25,C26,A30,B30,B31,B32,B1,E30," _
& "E31,E32,G30,G31,G32,I30,I31,I32,K30,K31,K32,M30,M31,M32,N1"
l = 1
With Tabelle2
' Zeile = wks1.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
For Each c In .Range(s)
wks1.Cells(Zeile, l) = c
l = l + 1
Next c
End With
'Call Sortieren_nach_Firma_Aufwärts
End If
End Sub
Anzeige
AW: Aufgerufene Daten in die Zeile zurückschreiben
11.05.2006 17:39:15
Franz
Hallo Wolfgang,
dein Code ist etwas schwierig zu testen, da weitere Prozeduren aufgerufen werden und einige Objekte in den Dim-Zeilen fehlten und nicht mit Set gesetzt waren. Nachdem ich für's Testen ein paar Sachen bereinigt hatte, funktionierte das Lesen und Speichern der Zeilen-Nummern mit den Ergänzungen in den Dim-Anweisungen und Set-Anweisungen für die Worksheet-Objekt-Variable wks1. Falls wks1 anderweitig als Public deklariert wurde, dann erübrigen sich diese Ergänzungen.

Code für Tabellenblatt:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SuBe As Range, s As String, wks1 As Worksheet
Set wks1 = ActiveWorkbook.Sheets("Tabelle1") ' Zeile bitte prüfen!!!!
Application.ScreenUpdating = False
On Error GoTo Fehler
If Target.Value = "" Then Exit Sub 'Call Datenblatt_Ohne_nachfrage_löschen '
s = Target.Text
Select Case Target.Address(0, 0)
Case "B1"
Call Objekt_Nr_Daten_Suchen
Set SuBe = wks1.Range("A2:A1000").Find(What:=s, _
After:=wks1.Range("A1000"), Lookat:=xlWhole)
Zeile = SuBe.Row
Case "C1"
Set SuBe = wks1.Range("B2:B1000").Find(What:=s, _
After:=wks1.Range("B1000"), Lookat:=xlWhole)
Zeile = SuBe.Row
Case Else: Exit Sub
End Select
Code in einem Modul:
Option Explicit
Public Zeile As Long
Sub Datenblatt_Werte_nach_DATA_Schreiben()
Dim c As Range, s As String, l As Integer, j As Long, wks1 As Worksheet
Set wks1 = ActiveWorkbook.Sheets("Tabelle3") ' Zeile prüfen!!!!!
If MsgBox("Soll der Inhalt des Datenblattes in die Datenbank eingegeben werden ?" _
& Chr(13) & "Die Daten werden in der Datenbank automatisch nach Alphabet einsortiert!", _
vbQuestion + vbYesNo, "Inhalt des Datenblattes nach DATA Einfügen und Sortieren") = vbYes Then
s = "B1,C1,L1,C2,F2,H2,L2,C3,H3,C6,E6,H6,J6,L6,B1,C7,E7,H7,J7,L7,C8," _
& "E8,H8,J8,L8,C9,E9,H9,J9,L9,C10,E10,H10,J10,L10,B1,C12,C14,C15,C16," _
& "C17,C18,C19,C20,C21,C22,C23,C24,C25,C26,A30,B30,B31,B32,B1,E30," _
& "E31,E32,G30,G31,G32,I30,I31,I32,K30,K31,K32,M30,M31,M32,N1"
l = 1
With Tabelle2  'würde ich ändern in ActiveWorkbook.Sheets("Tabellenname")
' Zeile = wks1.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
For Each c In .Range(s)
wks1.Cells(Zeile, l) = c.Value
l = l + 1
Next c
End With
'Call Sortieren_nach_Firma_Aufwärts
End If
End Sub

Gruß
Franz
Anzeige
AW: Funktioniert bestens ; vielen Dank
11.05.2006 22:53:37
Wolfgang
Hallo Franz
es funktioniert super.
Das hast Du genial hinbekomme.
Ich Danke Dir 1000 mal für Deine Mühe, die du Dir für mich gemacht hast und sprech Dir hiermit ein großes Lob aus.
Herzliche Grüße Wolfgang

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige