Aufgerufene Daten in die Zeile zurückschreiben
09.05.2006 20:20:56
Wolfgang
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