Supportnet / Forum / Tabellenkalkulation
Problem beim suchen und kopieren Makro
Frage
Hallo Zusammen,
ich benutze den unten eingefügten Code zum suchen und kopieren in einer Excel Arbeitsmappe. Mein Problem: Das Makro arbeitet unter Excel ´97 ohne Probleme..unter Excel XP verweigert Es seinen Dienst. Dieses äußert so das unter Excel XP immer nur die Msg_Box "1 Auto existiert nicht" angezeigt wird..obwohl der Datensatz im Sheet "Bestand" vorhanden ist. Da ich mich nicht so doll mit VBA auskenne wäre ich für einen Tipp zur Änderung auf Excel XP dankbar.
Viele Grüße
Locke266
[/code]
Sub Vergleich_Autos()
Application.ScreenUpdating = False
Dim Auto1
Dim Auto2
Dim Auto3
Dim Auto4
Dim Auto5
Set Auto1 = Sheets("Auswertung").Range("Auto1")
Set Auto2 = Sheets("Auswertung").Range("Auto2")
Set Auto3 = Sheets("Auswertung").Range("Auto3")
Set Auto4 = Sheets("Auswertung").Range("Auto4")
Set Auto5 = Sheets("Auswertung").Range("Auto5")
If Worksheets("Auswertung").[b5] > 0 Then
Sheets("Bestand").Select
Cells.Find(What:=(Auto1), After:=ActiveCell _
, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
).Activate
ActiveCell.Select
ActiveCell.Offset(0, -1).Activate
ActiveCell.Select
If Worksheets("Auswertung").[b5] = ActiveCell Then
Selection.EntireRow.Select
Selection.Copy
Worksheets("Autoliste").Select
[a12].Select
ActiveSheet.Paste
Application.CutCopyMode = False
Worksheets("Auswertung").Select
[b50:c50].Select
Selection.Copy
Worksheets("Autoliste").Select
[u12].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ElseIf ActiveCell <> Worksheets("Auswertung").[b5] Then
Beep
MsgBox ("1 Auto existiert nicht!")
End If
usw. (5x)
[code][/code]
Antwort 1 von Locke266
Huch...hat wirklich Keiner eine Idee wie ich das Problem angehen kann? ...oder war Irgendwas an dem Posting falsch? ;-)
Ich versuche mal zu beschreiben was das Makro genau tut (tuen sollte)... vielleicht kann mir dann ja Jemand helfen. :-)
Also.... das Ganze ist eine reine Ausfüllhilfe. Es soll die Daten vom Sheet "Bestand" nehmen (wobei Auto1 z.B. den Daten in den Zellen B5+C5 entspricht). Dort werden dann nur Kürzel eingegeben. Also z.B. 2006 + 030. Nun soll Es diese Daten nehmen und im Sheet "Bestand" finden. Wenn Sie Dort nebeneinander stehend gefunden sind; soll die entsprechende Zeile mit dem kompletten Datensatz markiert und kopiert werden. Anschließend soll die Zeile im Sheet "Autoliste" eingefügt werden.
Wie gesagt...das Makro arbeitet unter Excel ´97 prima...und unter XP wird immer nur die MsgBox angezeigt. Vielleicht gibts unter XP ja auch eine einfachere Möglichkeit diese Aufgabe zu lösen?
Ich hoffe das ich Das einigermaßen verständlich erklärt habe...und baue auch Eure Hilfe. :-) Vielen Dank im Voraus... ;-)
Grüße
Locke266
Ich versuche mal zu beschreiben was das Makro genau tut (tuen sollte)... vielleicht kann mir dann ja Jemand helfen. :-)
Also.... das Ganze ist eine reine Ausfüllhilfe. Es soll die Daten vom Sheet "Bestand" nehmen (wobei Auto1 z.B. den Daten in den Zellen B5+C5 entspricht). Dort werden dann nur Kürzel eingegeben. Also z.B. 2006 + 030. Nun soll Es diese Daten nehmen und im Sheet "Bestand" finden. Wenn Sie Dort nebeneinander stehend gefunden sind; soll die entsprechende Zeile mit dem kompletten Datensatz markiert und kopiert werden. Anschließend soll die Zeile im Sheet "Autoliste" eingefügt werden.
Wie gesagt...das Makro arbeitet unter Excel ´97 prima...und unter XP wird immer nur die MsgBox angezeigt. Vielleicht gibts unter XP ja auch eine einfachere Möglichkeit diese Aufgabe zu lösen?
Ich hoffe das ich Das einigermaßen verständlich erklärt habe...und baue auch Eure Hilfe. :-) Vielen Dank im Voraus... ;-)
Grüße
Locke266
Antwort 2 von schnallgonz
Salve,
also ich verstehe schon mal gar nicht, dass Dein Makro in Excel97 funzen soll.
Du suchst im Blatt Bestand nach dem Wert aus Auto1, der in B5 gefunden wird.
Von dort gehst Du nach A5 und vergleichst diese jetzt aktive Zelle mit B5, alles im Blatt Bestand.
A5 <> B5, also folgt die MsgBox.
gruß
schnallgonz
also ich verstehe schon mal gar nicht, dass Dein Makro in Excel97 funzen soll.
Du suchst im Blatt Bestand nach dem Wert aus Auto1, der in B5 gefunden wird.
Von dort gehst Du nach A5 und vergleichst diese jetzt aktive Zelle mit B5, alles im Blatt Bestand.
A5 <> B5, also folgt die MsgBox.
gruß
schnallgonz
Antwort 3 von Locke266
Hi schnallgonz,
...sorry.... da ist ein Fehler in meiner Erklärung zum Makro.
Richting muß es natürlich heißen:
Es soll die Daten vom Sheet "Auswertung" nehmen (wobei Auto1 z.B. den Daten in den Zellen B5+C5 entspricht). Dort werden dann nur Kürzel eingegeben. Also z.B. 2006 + 030. Nun soll Es diese Daten nehmen und im Sheet "Bestand" finden. Wenn Sie Dort nebeneinander stehend gefunden sind; soll die entsprechende Zeile mit dem kompletten Datensatz markiert und kopiert werden. Anschließend soll die Zeile im Sheet "Autoliste" eingefügt werden.
Gruß
Locke266
...sorry.... da ist ein Fehler in meiner Erklärung zum Makro.
Richting muß es natürlich heißen:
Es soll die Daten vom Sheet "Auswertung" nehmen (wobei Auto1 z.B. den Daten in den Zellen B5+C5 entspricht). Dort werden dann nur Kürzel eingegeben. Also z.B. 2006 + 030. Nun soll Es diese Daten nehmen und im Sheet "Bestand" finden. Wenn Sie Dort nebeneinander stehend gefunden sind; soll die entsprechende Zeile mit dem kompletten Datensatz markiert und kopiert werden. Anschließend soll die Zeile im Sheet "Autoliste" eingefügt werden.
Gruß
Locke266
Antwort 4 von fürLau
Leider verloren....
Antwort 5 von Locke266
???
Muß ich Das jetzt verstehen? ;-)
Muß ich Das jetzt verstehen? ;-)
Antwort 6 von Jana_
@ fürLau / Antwort 4:
Meintest Du den Boxer Sebastian Sylvester ? Der hat zum Schluss ganz schön was abbekommen.
Ansonsten glaube ich nicht, dass der Code da oben in Excel 97 läuft und in Excel XP nicht. Das würde ja bedeuten, dass Excel nicht abwärtskompatibel ist.
Ich kann es aber leider nicht testen, da ich kein Excel XP habe. Außerdem fehlt ja sowieso die Hälfte, mindestens ein End If und ein End Sub.
Gruß, Jana
Meintest Du den Boxer Sebastian Sylvester ? Der hat zum Schluss ganz schön was abbekommen.
Ansonsten glaube ich nicht, dass der Code da oben in Excel 97 läuft und in Excel XP nicht. Das würde ja bedeuten, dass Excel nicht abwärtskompatibel ist.
Ich kann es aber leider nicht testen, da ich kein Excel XP habe. Außerdem fehlt ja sowieso die Hälfte, mindestens ein End If und ein End Sub.
Gruß, Jana
Antwort 7 von vso
Hi Locke266,
ist schon seltsam, dass das unter XP nicht funzen soll.
Laß das Makro doch mal im Einzelschrittmodus ablaufen und guck, was passiert.
Viel Erfolg,
vso
ist schon seltsam, dass das unter XP nicht funzen soll.
Laß das Makro doch mal im Einzelschrittmodus ablaufen und guck, was passiert.
Viel Erfolg,
vso
Antwort 8 von Locke266
@vso
....habe ich schon. Das Teil läuft auch ohne Fehlermeldungen durch. Nur findet Es die Daten nicht...obwohl Sie garantiert vorhanden sind. Endet immer mit der Box (unter XP).
@Jana_
Hier ist das Makroimmer noch gekürzt...mit End Sub. Wollte ich Euch an sich ersparen...wegen der Länge...und ist ja im Prinzip immer das Gleiche.
Grüße
Sub Vergleich_Autos()
Application.ScreenUpdating = False
Dim Auto1
Dim Auto2
Dim Auto3
Dim Auto4
Dim Auto5
Dim Auto6
Dim Auto7
Dim Auto8
Dim Auto9
Dim Auto10
Dim Auto11
Dim Auto12
Dim Auto13
Dim Auto14
Dim Auto15
Set Auto1 = Sheets("Auswertung").Range("Auto1")
Set Auto2 = Sheets("Auswertung").Range("Auto2")
Set Auto3 = Sheets("Auswertung").Range("Auto3")
Set Auto4 = Sheets("Auswertung").Range("Auto4")
Set Auto5 = Sheets("Auswertung").Range("Auto5")
Set Auto6 = Sheets("Auswertung").Range("Auto6")
Set Auto77 = Sheets("Auswertung").Range("Auto77")
Set Auto8 = Sheets("Auswertung").Range("Auto8")
Set Auto9 = Sheets("Auswertung").Range("Auto9")
Set Auto10 = Sheets("Auswertung").Range("Auto10")
Set Auto11 = Sheets("Auswertung").Range("Auto11")
Set Auto12 = Sheets("Auswertung").Range("Auto12")
Set Auto13 = Sheets("Auswertung").Range("Auto13")
Set Auto14 = Sheets("Auswertung").Range("Auto14")
Set Auto15 = Sheets("Auswertung").Range("Auto15")
If Worksheets("Auswertung").[b5] > 0 Then
Sheets("Bestand").Select
[a5].Select
Cells.Find(What:=(Auto1), After:=ActiveCell _
, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
).Activate
ActiveCell.Select
ActiveCell.Offset(0, -1).Activate
ActiveCell.Select
If Worksheets("Auswertung").[b5] = ActiveCell Then
Selection.EntireRow.Select
Selection.Copy
Worksheets("Autoliste").Select
[a12].Select
ActiveSheet.Paste
Application.CutCopyMode = False
Worksheets("Auswertung").Select
[b50:c50].Select
Selection.Copy
Worksheets("Autoliste").Select
[u12].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ElseIf ActiveCell <> Worksheets("Auswertung").[b5] Then
Beep
MsgBox ("1 Auto existiert nicht!")
End If
ElseIf Worksheets("Auswertung").[b5] <= 0 Then
Worksheets("Auswertung").Select
[a2].Select
End If
If Worksheets("Auswertung").[b6] > 0 Then
Sheets("Bestand").Select
[a1].Select
Cells.Find(What:=(Auto2), After:=ActiveCell _
, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
).Activate
ActiveCell.Select
ActiveCell.Offset(0, -1).Activate
ActiveCell.Select
If Worksheets("Auswertung").[b6] = ActiveCell Then
Selection.EntireRow.Select
Selection.Copy
Worksheets("Autoliste").Select
[a13].Select
ActiveSheet.Paste
Application.CutCopyMode = False
Worksheets("Auswertung").Select
[b50:c50].Select
Selection.Copy
Worksheets("Autoliste").Select
[u13].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ElseIf ActiveCell <> Worksheets("Auswertung").[b6] Then
Beep
MsgBox ("2 Auto existiert nicht!")
End If
usw. .....bis Auto15
End Sub
....habe ich schon. Das Teil läuft auch ohne Fehlermeldungen durch. Nur findet Es die Daten nicht...obwohl Sie garantiert vorhanden sind. Endet immer mit der Box (unter XP).
@Jana_
Hier ist das Makroimmer noch gekürzt...mit End Sub. Wollte ich Euch an sich ersparen...wegen der Länge...und ist ja im Prinzip immer das Gleiche.
Grüße
Sub Vergleich_Autos()
Application.ScreenUpdating = False
Dim Auto1
Dim Auto2
Dim Auto3
Dim Auto4
Dim Auto5
Dim Auto6
Dim Auto7
Dim Auto8
Dim Auto9
Dim Auto10
Dim Auto11
Dim Auto12
Dim Auto13
Dim Auto14
Dim Auto15
Set Auto1 = Sheets("Auswertung").Range("Auto1")
Set Auto2 = Sheets("Auswertung").Range("Auto2")
Set Auto3 = Sheets("Auswertung").Range("Auto3")
Set Auto4 = Sheets("Auswertung").Range("Auto4")
Set Auto5 = Sheets("Auswertung").Range("Auto5")
Set Auto6 = Sheets("Auswertung").Range("Auto6")
Set Auto77 = Sheets("Auswertung").Range("Auto77")
Set Auto8 = Sheets("Auswertung").Range("Auto8")
Set Auto9 = Sheets("Auswertung").Range("Auto9")
Set Auto10 = Sheets("Auswertung").Range("Auto10")
Set Auto11 = Sheets("Auswertung").Range("Auto11")
Set Auto12 = Sheets("Auswertung").Range("Auto12")
Set Auto13 = Sheets("Auswertung").Range("Auto13")
Set Auto14 = Sheets("Auswertung").Range("Auto14")
Set Auto15 = Sheets("Auswertung").Range("Auto15")
If Worksheets("Auswertung").[b5] > 0 Then
Sheets("Bestand").Select
[a5].Select
Cells.Find(What:=(Auto1), After:=ActiveCell _
, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
).Activate
ActiveCell.Select
ActiveCell.Offset(0, -1).Activate
ActiveCell.Select
If Worksheets("Auswertung").[b5] = ActiveCell Then
Selection.EntireRow.Select
Selection.Copy
Worksheets("Autoliste").Select
[a12].Select
ActiveSheet.Paste
Application.CutCopyMode = False
Worksheets("Auswertung").Select
[b50:c50].Select
Selection.Copy
Worksheets("Autoliste").Select
[u12].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ElseIf ActiveCell <> Worksheets("Auswertung").[b5] Then
Beep
MsgBox ("1 Auto existiert nicht!")
End If
ElseIf Worksheets("Auswertung").[b5] <= 0 Then
Worksheets("Auswertung").Select
[a2].Select
End If
If Worksheets("Auswertung").[b6] > 0 Then
Sheets("Bestand").Select
[a1].Select
Cells.Find(What:=(Auto2), After:=ActiveCell _
, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
).Activate
ActiveCell.Select
ActiveCell.Offset(0, -1).Activate
ActiveCell.Select
If Worksheets("Auswertung").[b6] = ActiveCell Then
Selection.EntireRow.Select
Selection.Copy
Worksheets("Autoliste").Select
[a13].Select
ActiveSheet.Paste
Application.CutCopyMode = False
Worksheets("Auswertung").Select
[b50:c50].Select
Selection.Copy
Worksheets("Autoliste").Select
[u13].Select
ActiveSheet.Paste
Application.CutCopyMode = False
ElseIf ActiveCell <> Worksheets("Auswertung").[b6] Then
Beep
MsgBox ("2 Auto existiert nicht!")
End If
usw. .....bis Auto15
End Sub
Antwort 9 von CaroS
Hallo Locke,
ist doch klar. Wenn Du im ELSE-Zweig
ElseIf ActiveCell <> Worksheets("Auswertung").[b5] Then
Beep
MsgBox ("1 Auto existiert nicht!")
von If Worksheets("Auswertung").[b5] = ActiveCell Then landest, dann ist die Bedingung
Worksheets("Auswertung").[b5] = ActiveCell
nicht erfüllt. Also, was steht in der Tabelle Auswertung in Zelle B5?
Und welche Zelle ist zur Laufzeit die aktive Zelle und was steht da drin?
Das hängt davon ab, was bei der Anweisung
Cells.Find(What:=(Auto1), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
und dem anschließenden Offset
ActiveCell.Select
ActiveCell.Offset(0, -1).Activate
ActiveCell.Select
um eine Spalte nach links rauskommt. Das kannst Du Dir ja mal im Einzelschrittmodus mit Überwachung ansehen (dazu [+] r aufklappen, [+] CurrentRegion aufklappen, dort unter Column und Row)
oder Du kopierst Dir die 4 Zeilen direkt unter das ActiveCell.Select:
Dim r As Range
Set r = ActiveCell
MsgBox r.Address & " = " & r.Value
MsgBox "Vergleich ergibt: " & CStr(CBool(Worksheets("Auswertung").[b5] = ActiveCell)), , "Worksheets(""Auswertung"").[b5] = ActiveCell"
Gruß,
CaroS
ist doch klar. Wenn Du im ELSE-Zweig
ElseIf ActiveCell <> Worksheets("Auswertung").[b5] Then
Beep
MsgBox ("1 Auto existiert nicht!")
von If Worksheets("Auswertung").[b5] = ActiveCell Then landest, dann ist die Bedingung
Worksheets("Auswertung").[b5] = ActiveCell
nicht erfüllt. Also, was steht in der Tabelle Auswertung in Zelle B5?
Und welche Zelle ist zur Laufzeit die aktive Zelle und was steht da drin?
Das hängt davon ab, was bei der Anweisung
Cells.Find(What:=(Auto1), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
und dem anschließenden Offset
ActiveCell.Select
ActiveCell.Offset(0, -1).Activate
ActiveCell.Select
um eine Spalte nach links rauskommt. Das kannst Du Dir ja mal im Einzelschrittmodus mit Überwachung ansehen (dazu [+] r aufklappen, [+] CurrentRegion aufklappen, dort unter Column und Row)
oder Du kopierst Dir die 4 Zeilen direkt unter das ActiveCell.Select:
Dim r As Range
Set r = ActiveCell
MsgBox r.Address & " = " & r.Value
MsgBox "Vergleich ergibt: " & CStr(CBool(Worksheets("Auswertung").[b5] = ActiveCell)), , "Worksheets(""Auswertung"").[b5] = ActiveCell"
Gruß,
CaroS
Antwort 10 von CaroS
Hallo,
kleiner Schreib- und Kopierfehler. Auch für die Überwachung wäre es günstig, die beiden fetten Zeilen einzufügen und dann r zu überwachen:
ActiveCell.Select
Dim r As Range
Set r = ActiveCell
Gruß,
CaroS
kleiner Schreib- und Kopierfehler. Auch für die Überwachung wäre es günstig, die beiden fetten Zeilen einzufügen und dann r zu überwachen:
ActiveCell.Select
Dim r As Range
Set r = ActiveCell
Gruß,
CaroS
Antwort 11 von Locke266
Hallo CaroS,
...als erstes Mal vielen dank für Deine Mühe. Ich denke Du hast den richtigen Ansatz gefunden. :-)
Ich habe Deinen Vierzeiler in mein Makro kopiert...weil ich keinen Unterschied zu den beiden nachgereichten Fetten Zeilen gefunden habe.
Habe dann zum Testen im Sheet "Auswertung" in Feld b5 den Wert 2233 eigetragen...in c5 eine 181...weil ich genau weiß das eine Zeile mit genau diesen Werten im Sheet "Bestand" steht. Die 2233 steht dort in c11...die 181 in d11.
Als nächstes habe ich das Makro im Einzelschritt unter Ecxel97 ausgeführt. Dort zeigte mir Deine erste Box "$C$11=2233".... die zweite logischerweise dann "Wert ist wahr". Die Zeile wurde kopiert...und wie gewünscht in den Sheet "Autoliste" reinkopiert.
Unter EcxelXP sah das Ganze dann etwas anders aus... Ich habe natürlich die gleichen Werte benutzt... beim Durchlaufen der Einzelschritte sagte die erste Box "$B$8=80" (der Wert steht wirklich in der Zelle). Die zweite dann (auch klar) " Wert ist falsch". Im weiteren Ablauf kam dann meine Box "1 Auto existiert nicht".
So viel zum Thema das ein und das selbe Makro unter 97 und XP das selbe tun sollte.... ;-)
Grüße
Locke266
...als erstes Mal vielen dank für Deine Mühe. Ich denke Du hast den richtigen Ansatz gefunden. :-)
Ich habe Deinen Vierzeiler in mein Makro kopiert...weil ich keinen Unterschied zu den beiden nachgereichten Fetten Zeilen gefunden habe.
Habe dann zum Testen im Sheet "Auswertung" in Feld b5 den Wert 2233 eigetragen...in c5 eine 181...weil ich genau weiß das eine Zeile mit genau diesen Werten im Sheet "Bestand" steht. Die 2233 steht dort in c11...die 181 in d11.
Als nächstes habe ich das Makro im Einzelschritt unter Ecxel97 ausgeführt. Dort zeigte mir Deine erste Box "$C$11=2233".... die zweite logischerweise dann "Wert ist wahr". Die Zeile wurde kopiert...und wie gewünscht in den Sheet "Autoliste" reinkopiert.
Unter EcxelXP sah das Ganze dann etwas anders aus... Ich habe natürlich die gleichen Werte benutzt... beim Durchlaufen der Einzelschritte sagte die erste Box "$B$8=80" (der Wert steht wirklich in der Zelle). Die zweite dann (auch klar) " Wert ist falsch". Im weiteren Ablauf kam dann meine Box "1 Auto existiert nicht".
So viel zum Thema das ein und das selbe Makro unter 97 und XP das selbe tun sollte.... ;-)
Grüße
Locke266