AW: Worksheet_Change Problem
17.04.2006 20:22:29
Wolfgang
Hallo Peter
Das Makro funktioniert.
Ich hab es an meine Orginal - Datei angepasst.
Und jetzt weiss ich wo der Fehler liegt!
Zelle B1 sowie C1 werden auch neu beschrieben und damit startet das Makro wieder und wird damit endlos.
Läßt sich das Makro so schreiben das es nur einmal die Routine durchläuft und dann Stoppt.
Ich hab das angepasste Marko copiert, vielleicht kannst Du Dir das es Ja mal Anschauen und hast Du für mich ja eine Lösung würde mich sehr freuen.
Ich Danke Dir für Deinen Lösungsweg
Gruß Wolfgang
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SuBe As Range, s As String
If Target.Value = "" Then Exit Sub
s = Target.Text
Select Case Target.Address(0, 0)
Case "B1"
Set SuBe = Worksheets("DATA").Range("A2:A1000").Find(What:=s, _
After:=Worksheets("DATA").Range("A1000"), LookAt:=xlWhole)
Case "C1"
Set SuBe = Worksheets("DATA").Range("B2:B1000").Find(What:=s, _
After:=Worksheets("DATA").Range("B1000"), LookAt:=xlWhole)
Case Else: Exit Sub
End Select
If Not SuBe Is Nothing Then
Range("B1").Value = Worksheets("DATA").Range("A" & SuBe.Row).Value
Range("C1").Value = Worksheets("DATA").Range("B" & SuBe.Row).Value
Range("L1").Value = Worksheets("DATA").Range("C" & SuBe.Row).Value
Range("C2").Value = Worksheets("DATA").Range("D" & SuBe.Row).Value
Range("F2").Value = Worksheets("DATA").Range("E" & SuBe.Row).Value
Range("H2").Value = Worksheets("DATA").Range("F" & SuBe.Row).Value
Range("L2").Value = Worksheets("DATA").Range("G" & SuBe.Row).Value
Range("C3").Value = Worksheets("DATA").Range("H" & SuBe.Row).Value
Range("H3").Value = Worksheets("DATA").Range("I" & SuBe.Row).Value
Range("C6").Value = Worksheets("DATA").Range("J" & SuBe.Row).Value
Range("E6").Value = Worksheets("DATA").Range("K" & SuBe.Row).Value
Range("H6").Value = Worksheets("DATA").Range("L" & SuBe.Row).Value
Range("J6").Value = Worksheets("DATA").Range("M" & SuBe.Row).Value
Range("L6").Value = Worksheets("DATA").Range("N" & SuBe.Row).Value
Range("C7").Value = Worksheets("DATA").Range("P" & SuBe.Row).Value
Range("E7").Value = Worksheets("DATA").Range("Q" & SuBe.Row).Value
Range("H7").Value = Worksheets("DATA").Range("R" & SuBe.Row).Value
Range("J7").Value = Worksheets("DATA").Range("S" & SuBe.Row).Value
Range("L7").Value = Worksheets("DATA").Range("T" & SuBe.Row).Value
Range("C8").Value = Worksheets("DATA").Range("U" & SuBe.Row).Value
Range("E8").Value = Worksheets("DATA").Range("V" & SuBe.Row).Value
Range("H8").Value = Worksheets("DATA").Range("W" & SuBe.Row).Value
Range("J8").Value = Worksheets("DATA").Range("X" & SuBe.Row).Value
Range("L8").Value = Worksheets("DATA").Range("Y" & SuBe.Row).Value
Range("C9").Value = Worksheets("DATA").Range("Z" & SuBe.Row).Value
Range("E9").Value = Worksheets("DATA").Range("AA" & SuBe.Row).Value
Range("H9").Value = Worksheets("DATA").Range("AB" & SuBe.Row).Value
Range("J9").Value = Worksheets("DATA").Range("AC" & SuBe.Row).Value
Range("L9").Value = Worksheets("DATA").Range("AD" & SuBe.Row).Value
Range("C10").Value = Worksheets("DATA").Range("AE" & SuBe.Row).Value
Range("E10").Value = Worksheets("DATA").Range("AF" & SuBe.Row).Value
Range("H10").Value = Worksheets("DATA").Range("AG" & SuBe.Row).Value
Range("J10").Value = Worksheets("DATA").Range("AH" & SuBe.Row).Value
Range("L10").Value = Worksheets("DATA").Range("AI" & SuBe.Row).Value
Range("C12").Value = Worksheets("DATA").Range("AK" & SuBe.Row).Value
Range("C14").Value = Worksheets("DATA").Range("AL" & SuBe.Row).Value
Range("C15").Value = Worksheets("DATA").Range("AM" & SuBe.Row).Value
Range("C16").Value = Worksheets("DATA").Range("AN" & SuBe.Row).Value
Range("C17").Value = Worksheets("DATA").Range("AO" & SuBe.Row).Value
Range("C18").Value = Worksheets("DATA").Range("AP" & SuBe.Row).Value
Range("C19").Value = Worksheets("DATA").Range("AQ" & SuBe.Row).Value
Range("C20").Value = Worksheets("DATA").Range("AR" & SuBe.Row).Value
Range("C21").Value = Worksheets("DATA").Range("AS" & SuBe.Row).Value
Range("C22").Value = Worksheets("DATA").Range("AT" & SuBe.Row).Value
Range("C23").Value = Worksheets("DATA").Range("AV" & SuBe.Row).Value
Range("C24").Value = Worksheets("DATA").Range("AW" & SuBe.Row).Value
Range("C25").Value = Worksheets("DATA").Range("AX" & SuBe.Row).Value
Range("C26").Value = Worksheets("DATA").Range("AY" & SuBe.Row).Value
Range("A30").Value = Worksheets("DATA").Range("AZ" & SuBe.Row).Value
Range("B30").Value = Worksheets("DATA").Range("BA" & SuBe.Row).Value
Range("B31").Value = Worksheets("DATA").Range("BB" & SuBe.Row).Value
Range("B32").Value = Worksheets("DATA").Range("BC" & SuBe.Row).Value
Range("E30").Value = Worksheets("DATA").Range("BE" & SuBe.Row).Value
Range("E31").Value = Worksheets("DATA").Range("BF" & SuBe.Row).Value
Range("E32").Value = Worksheets("DATA").Range("BG" & SuBe.Row).Value
Range("G30").Value = Worksheets("DATA").Range("BH" & SuBe.Row).Value
Range("G31").Value = Worksheets("DATA").Range("BI" & SuBe.Row).Value
Range("G32").Value = Worksheets("DATA").Range("BJ" & SuBe.Row).Value
Range("I30").Value = Worksheets("DATA").Range("BK" & SuBe.Row).Value
Range("I31").Value = Worksheets("DATA").Range("BL" & SuBe.Row).Value
Range("I32").Value = Worksheets("DATA").Range("BM" & SuBe.Row).Value
Range("K30").Value = Worksheets("DATA").Range("BN" & SuBe.Row).Value
Range("K31").Value = Worksheets("DATA").Range("BO" & SuBe.Row).Value
Range("K32").Value = Worksheets("DATA").Range("BP" & SuBe.Row).Value
Range("M30").Value = Worksheets("DATA").Range("BQ" & SuBe.Row).Value
Range("M31").Value = Worksheets("DATA").Range("BR" & SuBe.Row).Value
Range("M32").Value = Worksheets("DATA").Range("BS" & SuBe.Row).Value
Range("N1").Value = Worksheets("DATA").Range("BT" & SuBe.Row).Value
Set SuBe = Nothing
Else
MsgBox "Suchbegriff '" & s & "' nicht gefunden !", 64, _
"Dezenter Hinweis für " & Application.UserName & ":"
End If
End Sub