Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Werkzeug
BildScreenshot zu Werkzeug Werkzeug-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema RefEdit
BildScreenshot zu RefEdit RefEdit-Seite mit Beispielarbeitsmappe aufrufen

Bereich syncronisieren II


Betrifft: Bereich syncronisieren II
von: Steve
Geschrieben am: 11.09.2019 16:16:01

Moin Matthias,

ich glaube ich habe dich falsch verstanden. Also erst einmal dachte ich, ich müsste beide von dir erstellten Makros einbauen.

Dann habe ich das ganze versucht auszuführen. Irgenwie ging das nicht.

Jetzt habe ich es anders gemacht.

Einmal habe ich das erste Makro ausprobiert. Das funktioniert bei mir irgendwie nicht.
In LISTE werd
en bei anlage eines neuen Blattes alle Verknüpfungen verändert.
Deren Bezugspunkt liegt dann immer auf dem letzten Blatt.

Beispiel: Ich lege zwei Blätter an. eigentlich müsste nun in Blatt 001 immer ='00'!$B$XY stehen.

Aber sobald Blatt 002 angelegt wird, ändern sich alle Verknüpfungen in: ='002'!$B$XY

Lege ich Blatt 003 an, verändern sich die Verknüpfungen von Blatt 001 und 002 entsprechend.

________________________________________________________________________

Dann habe ich dein zweites Makro ausprobiert. Das wollte zuerst auch nicht funktionieren. Aber dann habe ich meine beiden Blätter die ich zur Veranschaulichung angelegt habe archiviert und schon funktionierte es.
1. Korrektur - habe ich durchgeführt.

2. Preis
Ich habe deine Ergänzung der Preisänderung mit eingefügt und dann am Preis und Menge rumgespielt.

Wenn ein Artikel einmal eingegeben wurde und dann die Menge (ohne Preisänderung in DATEN) geändert wurde, dann wird es in dem Blatt, aber nicht in LISTE übernommen.

wird Artikel und Menge vollständig gelöscht (z.B. weil der Mitarbeiter das Material abgegeben hat) bleibt der Preis stehen.

Hier steige ich noch nicht so ganz durch.
Weil mir noch ein weiteres Rechenproblem eingefallen ist, denke ich muss ich da ohnehin noch einmal nachdenken.

Rechenproblem: Sagen wir mal jemand erhält ein Pullover zu 5€. Nun bekommt er einen zweiten Pullover. Ich erhöhe die Menge. Hat sich aber in der Zwischenzeit der Preis auf 7€ geändert. Müsste der Gesamtpreis jetzt 12€ sein.

Ich glaube das wolltest du mit der Hilfsspalte abfangen. Aber ich fürchte ich stehe da auf dem Schlauch. Ich nehme an die entsprechende Änderung (Hilfsspalte) muss in dem Blatt MASTER (versteckt)sein. Aber irgendwie verstehe ich nicht wo genau.

3. Code
Makros sind eingeschaltet. Ist hier nicht so das Problem.

4. Sichtbarkeit
Danke. Werden also gelöscht.

5 & 6 & 7
Danke. Ich bezog mich eigentlich auf die automatischen Verknüpfungen.
Da ich mich allerdings für DIESESARBEITSBLATT entschieden habe, muss ich mal ausprobieren ob, bzw. wie ich es schaffe diese Lösung noch für andere Bereiche zu übertragen.

Derzeit decken sie ja die Bereiche für Material und Kleidung ab.
Ich möchte aber noch den Bereich Arbeitsanweisungen und Fahrpersonal (genauer Spalte O) abdecken.
Mal sehen ob ich das alleine schaffe. Möchte ja auch was gelernt haben.
Würde mich melden falls ich es überhaup nicht schaffe, wenn das in Ordnung ist.

8 Problem
hat sich erledigt, da es sich auf die Verknüpfungen konzentrierte.

Okay, das war nun auch viel Text.

Ich hoffe der nächste wird kürzer.

Liebe Grüße

Steve

  

Betrifft: AW: Bereich syncronisieren II
von: 1712537.html
Geschrieben am: 11.09.2019 19:08:34

Moin!
1. Version mit Links
Also bzgl. der Links musste ich mal schauen. Da lag das Problem an der intelligenten Tabelle. Wenn die Formeln ähnlich sind, passen die sich automatisch an. Das könnte man umgehen, indem man dort einen bestimten Punkt der Autokorrektur ausschaltet und nach dem Eintragen wieder ein. Das sollte so gehen:
Application.AutoCorrect.AutoFillFormulasInLists = False
bzw. danach wieder auf true.
Damit sollte der Link zum richtigen Blatt in jeder Zeile stehen.

2. Preis Liste Problem.
Ändere mal die Reihenfolge in SheetChange. Sollte so aussehen:
preiserfassen sh, Target
aktualisieren sh, Target
War mir gestern noch eingefallen, da war aber der Rechner schon aus. Der Preis wird ja bei der Änderung der Anzahl übertragen. Vorher wurde der Preis aber erst nach der Änderung geändert. DAmit sollte es passen. Bzgl. des Löschen hier noch eine Änderung am Code. Damit werden die Änderungen am Material (Löschen, Ändern) mit abgefangen. Einfach die Prozedur austauschen.

Sub preiserfassen(Sh As Object, ByVal Target As Range)
          On Error GoTo ende
          Dim daten
          Dim zeile
          Dim zelle
          
          daten = Worksheets("Daten").UsedRange
          
          
          
          If Target.Column = 3 Or Target.Column = 2 Then
              Set zelle = Sh.Cells(Target.Row, 3)
              If zelle.Offset(, -1) <> "" And zelle <> "" And zelle <> "-" Then
                  Set zeile = Worksheets("Daten").Columns(1).Find(zelle.Offset(, -1), LookIn:=xlValues,  _
          lookat:=xlWhole)
                  If Not zeile Is Nothing Then
                      If zeile.Offset(, 2) = "Menge" Then
                          'Produkt
                          Application.EnableEvents = False
                          zelle.Offset(, 1) = CDbl(zelle) * CDbl(zeile.Offset(, 1))
                          Application.EnableEvents = True
                      Else
                          'nur die Nummer
                          Application.EnableEvents = False
                          zelle.Offset(, 1) = zeile.Offset(, 1)
                          Application.EnableEvents = True
                      End If
                  Else
                      Exit Sub
                  End If
              Else
                  zelle.Offset(, 1) = ""
              End If
          End If
          
          If Target.Column = 8 Or Target.Column = 7 Then
              Set zelle = Sh.Cells(Target.Row, 3)
              If zelle.Offset(, -1) <> "" And zelle <> "" And zelle <> "-" Then
                  Set zeile = Worksheets("Daten").Columns(1).Find(zelle.Offset(, -1), LookIn:=xlValues,  _
          lookat:=xlWhole)
                  If Not zeile Is Nothing Then
                  Application.EnableEvents = False
                      zelle.Offset(, 1) = CDbl(zelle) * CDbl(zeile.Offset(, 1))
                      Application.EnableEvents = True
                  Else
                      Exit Sub
                  End If
              Else
                  zelle.Offset(, 1) = ""
              End If
          End If
          
          ende:
          Application.EnableEvents = True
          
          End Sub
3. Berechnungsproblem:
Also um später besser nachzuvollziehen, warum sich der Preis geändert hat, wäre natürlich das Beste, du änderst bei einer weiteren Eingabe des selben Materials nicht die Anzahl sondern machst einen extra Eintrag.
Ansonsten könnte es kompliziert werden. Angenommen die Jacken sind mit Echtgold bestickt. :-) Wenn sich der Goldpreis ändert, werden die Jacken auch teurer. Wie viele Zwischenpreise will man dann speichern. Und was passiert, wenn du die Anzahl dann wieder runter korrigierst. Grundsätzlich kann man das machen aber ich glaube das wird eine heiden Rechnerei und da könnten Fehler vorprogrammiert sein. Was man anbieten kann, ist einen Hinweis an den User, dass sich der Preis geändert hat. Dazu mal hier wieder ein Codebaustein. Der gehört auch wieder in die DieseArbeitsmappe. Hierbei kommt eine Fehlermeldung, wenn man Anzahl anklickt und der Preis ist ein anderer. An Stelle der Meldung könnte man auch gleich eine andere Zelle (zwangsweise) selektieren, so dass man dort händisch keine Anzahl mehr ändern kann.
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
          Dim blattno, bereich
              Dim quellbereich, zelle
              
              
              'die blätter bei denen nix passierne soll
              blattno = Array("Inaktive", "Daten", "Startseite", "Liste", "Master")
              quellbereich = Array("C5:C24", "H5:H25")
              If InStr(1, "@" & Join(blattno, "@") & "@", Sh.Name, vbTextCompare) > 0 Then Exit Sub
              
              If Target.Count = 1 Then
              'nur ein Eintrag erfolgte
                  If Not Intersect(Target, Union(Sh.Range(quellbereich(0)), Sh.Range(quellbereich(1))))  _
          Is Nothing Then
                      preisvergleich Sh, Target
                  End If
              Else
              'mehrere Einträge erfolgen
                  For Each zelle In Target
                      If Not Intersect(zelle, Union(Sh.Range(quellbereich(0)), Sh.Range(quellbereich(1)))) _
           Is Nothing Then
                          preisvergleich Sh, zelle
                  End If
                  Next
              End If
          End Sub
          
          Sub preisvergleich(Sh As Object, ByVal Target As Range)
          Dim altpreis, zeile, neupreis
              If Target.Offset(, -1) <> "" Then
                  Set zeile = Worksheets("Daten").Columns(1).Find(Target.Offset(, -1), LookIn:=xlValues,  _
          lookat:=xlWhole)
                  If Not zeile Is Nothing Then
                      neupreis = CDbl(zeile.Offset(, 1))
                      If zeile.Offset(, 2) = "Menge" Then
                          'Produkt
                          altpreis = CDbl(Target.Offset(, 1)) / CDbl(Target)
                      Else
                          'nur die Nummer
                          altpreis = CDbl(Target.Offset(, 1)) / CDbl(Target)
                      End If
                      
                      If altpreis <> neupreis Then
              
                          MsgBox "Vorsicht die Preise haben sich geändert! Besser wäre es eine neue Zeile  _
          anzulegen!", , "Preisänderung"
                      End If
             
                  Else
                      Exit Sub
                  End If
              End If
          
          End Sub

4. Anpassungen
Bei Fragen ruhig melden. Wollte jetzt nicht spoilern aber als Tipp, schau mal wo die verschiedenen Ranges angelegt sind und wo sie noch verwendet werden. Wobei der Teil im Code auch ein wenig anwenderfreundlicher in einer Schleife gelöst werden könnte. Dann müsste man nicht soviel manuel anpassen. Kann man ja noch im Nachgang machen / mitteilen, wenn du das brauchst.

Und bzgl. der Textlänge kein Problem. Die Antworten sind ja meist nicht kürzer. :-)

VG
  

Betrifft: AW: Bereich syncronisieren II
von: 1712896.html
Geschrieben am: 13.09.2019 13:16:28

Moin Matthias,

sorry das ich heute erst antworte. Habe es leider vorher nicht geschafft.

1. Danke dir dafür. Das habe ich ausprobiert und funktioniert hervorragend. Da ich mich ja schon für die andere Variante entschieden habe und wir dort auch die Preissache geregelt haben, denke ich legen wir das mit den Verknüpfungen mal ad Acta. (Möchte deine Hilfsbereitschaft nicht überstrapazieren)

2. Beides klappt hervorragend. Ich bin sehr begeistert.

3. Da musste ich was lachen. Super Beispiel von dir. So werde ich das handhaben. Besser einen zweiten Eintrag machen. Kommt auch nicht so oft vor.

Das mit der Fehlermeldung ist eine superklasse Idee. Irgendwann weiss man ja nicht mehr das sich der Preis geändert hat. Der Code wurde allerdings unterbrochen.
einmal bei der MSGBOX. (wurde rot markiert) Habe den Zeilenumbruch weggenommen. Dann war es wieder gut.
und nun wird wenn ich die Anzahl eingeben möchte (direkt bei einem neuen Sheet) folgendes gelb markiert: altpreis = CDbl(Target.Offset(, 1)) / CDbl(Target)
Möglich das er probleme mit noch leeren Zellen hat?

4. Anpassungen (danke fürs "nicht spoilern" und für den Tipp)
Ich glaube den richtigen Bereich für die Quelle schon gefunden zu haben.
DieseArbeitsmappe - Workbook_SheetChange - quellbereich = Array("B5:D24", "G5:I25")
Da muss ich auf jeden Fall schon einmal die Bereiche ("O5:O14", "O17:O24")hinzufügen.

Für das Ziel muss ich dann zu Sub aktualisieren, denke ich.
Allerdings stehe ich hier auf dem Schlauch. Ich glaube rauszulesen, das quasi die richtige Koordinate der zielzelle errechnet wird. Ich meine das hast du mir auch am Anfang so geschrieben. Ich fürchte ich verstehe es nur noch nicht. Hast du da ein Tipp für mich

eine Sache habe ich vielleicht doch verstanden. If und Else trennen Werkzeug von Kleidung

Liebe Grüße

Steve

  

Betrifft: AW: Bereich syncronisieren II
von: 1712899.html
Geschrieben am: 13.09.2019 13:19:50

Eine Sache noch. Wenn es für dich einfacher ist, können wir das Dropdown thread auch hier weiter erörtern. Dann musst du nicht zwei Threads beantworten.

Steve

  

Betrifft: AW: Bereich syncronisieren II
von: 1712975.html
Geschrieben am: 13.09.2019 16:28:16

Moin!
Der Hinweis kam zu spät:-)
zu3.
Genau das liegt an den Zellen. Ändere mal
If Target.Offset(, -1) <> ""
in
If Target.Offset(, -1) <> "" And Target <> "" And Target <> 0 Then
Ansonsten hätten wir unten bei der Preisberechnung eine Division durch 0. Das geht natürlich nicht. Hatte ich nicht berücksichtigt.
zu4.
Da ein klassischen Jein.
Grundsätzlich müsstest du den Bereich dort anpassen. Allerdings müsstest du dann nocmal beim Aufruf von preiserfassen schauen, in welchem Bereich du bist. Nur bei KLeidung und Waren gibt es ja einen Preis. Beim ersten intersect würde ich den dritten bzw. vierten Bereich mit aufnehmen. Beim Preiserfassen dann davor noch ein if then machen und nur die beiden ersten Bereiche prüfen (mit der intersect zeile wie bsiher einfach davor setzen i rahmen eines if then). Wenn das zutrifft, dann den Preis erfassen.
Für aktualisiern kann ich dir grad keinen Tipp geben, da ich nicht weiß, wohin du dort die Daten schreiben willst (ab welcher Spalte). Das gab es in deiner Beispielmappe noch nicht. Ich würde aber in aktualisieren ein elsif einfügen und prüfen, ob die spalte (column) = 15 ist. Je nachdem, wohin die DAten dann sollen, die Rechnung für die Zielspalte anstellen.
Wenn du dan ein Beispiel hast (Spaltenbereich mitteilen reicht) könnte ich die Rechnung basteln.

Zum if then.
Im SheeChange Ereignis trennt sie eine von mehreren Eingaben.
Unten in aktuaslisieren dann richtigerweise Kleidung von Waren. Für die anderen Bereich deshalb ein elseif oder mit select case arbeiten.
VG

  

Betrifft: AW: Bereich syncronisieren II
von: 1713342.html
Geschrieben am: 16.09.2019 16:13:25

Moin Matthias,

zu 3. Klappt super. Die Meldung der Preisänderung funktioniert ebenfalls.
Das war eine sehr gute Idee.

zu4.
ich habe nun das Wochenende darüber gegrübelt. Aber irgendwie ist das noch zu hoch für mich. (Oder ich stelle mich gerade dusselig an.

Also habe ich mal die Zielzellen eingefügt. Die liegen in dem Sheet LISTE Spalte DT:EK
Sind das die Spalten die du benötigst für die Rechnung?
Ich hänge dir sicherheitshalber mal die aktuelle Datei an.

https://www.herber.de/bbs/user/132056.zip

Liebe Grüße

Steve

  

Betrifft: AW: Bereich syncronisieren II
von: 1713374.html
Geschrieben am: 16.09.2019 21:17:24

Moin!
HIer mal der Code geändert. Ist nur das Sheet_Cahnge und aktualisiern.
Je nach Wert wird noch geschaut, ob ein PRei geprüft werde muss (in Spalte O ja nicht). Und die Werte werden übertragen. Dafür habe ich das if then in ein select case umgewandelt. Darin wird die Spalte in Liste berechnet. Die case sind die Spalten in den BLättern. Der Rest vom Code ist gleich geblieben. Evtl. nach dem Kopieren noch die vom Forum geetzten Zeilenu mbrüch raus machen.

    Option Explicit
         
         Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
         Dim blattno, bereich
         Dim quellbereich, zelle
     
         'die blätter bei denen nix passierne soll
         blattno = Array("Inaktive", "Daten", "Startseite", "Liste", "Master")
         quellbereich = Array("B5:D24", "G5:I25", "O5:O14", "O17:O24")
         If InStr(1, "@" & Join(blattno, "@") & "@", Sh.Name, vbTextCompare) > 0 Then Exit Sub
         
         If Target.Count = 1 Then
         'nur ein Eintrag erfolgte
             If Not Intersect(Target, Union(Sh.Range(quellbereich(0)), Sh.Range(quellbereich(1)), Sh. _
     Range(quellbereich(2)), Sh.Range(quellbereich(3)))) Is Nothing Then
     
                 If Not Intersect(Target, Union(Sh.Range(quellbereich(0)), Sh.Range(quellbereich(1))) _
     ) Is Nothing Then preiserfassen Sh, Target
                 aktualisieren Sh, Target
             End If
         Else
         'mehrere Einträge erfolgen
             For Each zelle In Target
                 If Not Intersect(Target, Union(Sh.Range(quellbereich(0)), Sh.Range(quellbereich(1)), _
      Sh.Range(quellbereich(2)), Sh.Range(quellbereich(3)))) Is Nothing Then
                     If Not Intersect(zelle, Union(Sh.Range(quellbereich(0)), Sh.Range(quellbereich( _
     1)))) Is Nothing Then preiserfassen Sh, zelle
                     aktualisieren Sh, zelle
             End If
             Next
         End If
         
         End Sub
         
         
         Sub aktualisieren(Sh As Object, ByVal Target As Range)
         
         Dim ziel
         Dim spalte
         Set ziel = Worksheets("LISTE").Columns(1).Find(Sh.Name, LookIn:=xlValues, lookat:=xlWhole)
         If ziel Is Nothing Then Exit Sub
                 Select Case Target.Column
                     'je nach Spaltennummer eine andere Zielzeile
                     Case 2, 3
                         spalte = Target.Column - 1 + 3 * (Target.Row - 4)
                     Case 7, 8
                         spalte = Target.Column - 6 + 3 * (Target.Row - 4) + 60
                     Case 15
                         If Target.Row < 15 Then
                             spalte = Target.Row + 119
                         Else
                             spalte = Target.Row + 117
                         End If
                 End Select
     
                 Worksheets("LISTE").Cells(ziel.Row, spalte) = Target.Value
                 If Target.Column = 3 Or Target.Column = 8 Then Worksheets("LISTE").Cells(ziel.Row,  _
     spalte + 1) = Target.Offset(, 1).Text
         End Sub
VG
  

Betrifft: AW: Bereich syncronisieren II
von: 1713460.html
Geschrieben am: 17.09.2019 12:57:43

Moin Matthias,

auch hier ein Riesen-Dankeschön. Du hast mir sehr geholfen. Und auch hier habe ich viel gelernt und muss auch noch viel lernen. Da gibt es noch einige Dinge in deinem Code die ich nur eingeschränkt begreife.
Aber ich bin guter Dinge das ich auch das im Laufe der Zeit verstehen werde.

Der Vorteil ist ja, das man alleine schon durch heurmprobieren und sukzessivem Verändern viel verstehen und lernen kann.

Also Danke für deine Unterstützung.

Liebe Grüße

Steve

  

Betrifft: Fehlermeldung
von: 1713502.html
Geschrieben am: 17.09.2019 15:55:30

Moin Matthias,

muss doch noch einmal was fragen.
Bei meinem ersten Versuch hab ich nur die neu von dir eingefügten Zellen ausprobiert.
Aber irgendwie erhalte ich bei einem neuen Blatt nun immer eine Fehlermeldung, wenn ich einen neuen Artikel anlege, aber noch keine Menge vorhanden ist.

In Sub aktualisieren wird folgendes Gelb markiert:

Worksheets("LISTE").Cells(ziel.Row, spalte) = Target.Value

Kann es sein dass das wieder mit den leeren Zellen zu tun hat?

Liebe Grüße

Steve

  

Betrifft: AW: Fehlermeldung
von: 1713503.html
Geschrieben am: 17.09.2019 16:00:38

Hab mal die Versionen überprüft. An dieser Stelle ist alles gleich. Ich verstehe nicht was jetzt falsch sein soll.

Steve

  

Betrifft: AW: Fehlermeldung
von: 1713532.html
Geschrieben am: 17.09.2019 18:29:57

Moin!
Das Problem war, dass die SUb aktualisiern auch auf Spalte 4 (Preis) Auswirkungen hat. Im Select case, hatte ich die Spalten aber vergessen. HIer ist es nun angepasst. Die Spalten mit den Preisen sind drin. Zudem noch eine Fehlermeldung. Ohne diese Spalte wäre die Variable spalte leer gewesen. Damit kan man dann aber nicht auf eine Zelle zugreifen.

Sub aktualisieren(Sh As Object, ByVal Target As Range)
     
     Dim ziel
     Dim spalte
     Set ziel = Worksheets("LISTE").Columns(1).Find(Sh.Name, LookIn:=xlValues, lookat:=xlWhole)
     If ziel Is Nothing Then Exit Sub
             Select Case Target.Column
                 'je nach Spaltennummer eine andere Zielzeile
                 Case 2, 3, 4
                     spalte = Target.Column - 1 + 3 * (Target.Row - 4)
                 Case 7, 8, 9
                     spalte = Target.Column - 6 + 3 * (Target.Row - 4) + 60
                 Case 15
                     If Target.Row < 15 Then
                         spalte = Target.Row + 119
                     Else
                         spalte = Target.Row + 117
                     End If
                     
                 Case Else
                     MsgBox "Ein Fehler ist aufgetreten. Es erfolgt kein Eintrag.", , "Fehler  _
 bei Spalte"
             End Select
 
             Worksheets("LISTE").Cells(ziel.Row, spalte) = Target.Value
             If Target.Column = 3 Or Target.Column = 8 Then Worksheets("LISTE").Cells(ziel.Row,  _
 spalte + 1) = Target.Offset(, 1).Text
     End Sub

Dann ist mir noch was aufgefallen. Bei der sub preiserfassen prüfen wir Anzahl und Name. Uspr. wollte ich da abfangen, wenn jemand die Anzahl ändert. HAbe das dann noch auf den Namen erweitert (also Name eine bereits gesetzen Zeile wird geändert). Weiß nicht ob das vorkommen kann. Das wirft dann aber einen FEhler aus. Nimm deshalb bitte mal in der sub preiserfassen das or Target.Column = 7 bzw. Or Target.Column = 2 raus. Dann sollte es klappen. Allerdings passiert nix, wenn du ein einer schon belegten Zelle das Material oder die KLeiung änderst. Das müsste man ggf. noch extra abfangen - wenn das vorkommen sollte.

Ich bräuchte dann aber mal die aktuellste Codeversion. Habe hier gesehen, dass meine Datei nicht alle Änderungen beinhaltet.

Wenn du ansonsten Fragen zum Code hast, einfach melden.
VG
  

Betrifft: AW: Fehlermeldung
von: 1713684.html
Geschrieben am: 18.09.2019 15:20:07

Moin Matthias,

das klappt ja hervorragend.

Nun möchte ich dich mal nicht weiter belästigen. Ich werde mir deinen Code jetzt mal eine Weile genauer anschauen und sehen was ich daraus lernen kann.

Ich danke dir für deine wirklich großartige Hilfe.

Liebe Grüße

Steve