Microsoft Excel

Herbers Excel/VBA-Archiv

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

Ich komme mit meiner Lagerdatei nicht weiter :(

Betrifft: Ich komme mit meiner Lagerdatei nicht weiter :( von: Sabrina
Geschrieben am: 14.11.2014 20:44:55

Hallo Leute,

ich komme mit meiner Lagerdatei nicht weiter. Mein Chef will dass ich es um Funktionen erweitere.

Die Funktion bislang . In den Zellen Z2 - Z33, AC2-AC25, AF2 - AF33 ( lila Farbe ) werden Lagernummern eingegeben. In dem Feld daneben der Status

Wenn ein Feld leer ist. Wird Links in der Übersicht das Feld Grün angezeigt.
Ist eine Zahl eingetragen wird es Rot angezeigt.
Ist die Zahl 400 Nummer kleiner als die größt vergebene Zahl Rosa.

Nun soll hinzukommen dass wenn der Status 3 (die Zahl steht rechts neben der Lagerzahl ) ist das Feld nicht Rot sondern Orange und wenn der Status 4 ist hellblau. ( evt. weitere Zahlen und Farben )

https://www.herber.de/bbs/user/93781.xls

Hat jemand eine Idee??

LG

Sabbel

  

Betrifft: AW: Ich komme mit meiner Lagerdatei nicht weiter :( von: Michael
Geschrieben am: 15.11.2014 00:32:27

Hallo Sabbel,

ich antworte ja nur, weil mir Dein Name so gefällt!

Ich hab Deine Worksheet_Change kopiert & umbenannt und sie deutlich gekürzt, um den Preis eines Hilfsblattes.
Dieses habe ich wiederum angelegt, um eine Referenz mit den Zellbezügen zu den einzelnen Regalen, die Du einfärben möchtest, herzustellen.

Im Prinzip läuft das Makro so:
- wenn was eingegeben wird, schaue in der Spalte links daneben nach der Regalbezeichnung (z.B. A7)
- suche im Hilfsblatt nach der Zelle, die dieser Regalbezeichnung entspricht (nämlich C9)
[Excel interessiert sich bei verbundenen Zellen nur für die linke, obere Ecke; der Rest ist "automatisch" mit dabei]
- schaue in der Spalte rechts der Eingabe nach dem Status
- Färbe die betreffende Zelle ein

Hier die geänderte Funktion mit ein paar Msg-Boxen, die Du dann ja rauslöschen kannst.
Für die Farbausgabe habe ich nur ein paar ifs verwendet; je nach dem könnte man ja noch ein verschachteltes case verwenden.
Wenn die Farbgebung ausufert, würde ich aber auf dem Hilfsblatt eine Matrix mit Farbwerten anlegen, dann mußt nicht jedesmal das Makro ändern, sondern nur dort umverformeln.

Hilfsblätter sind nicht jedermanns Sache. Falls Dein Chef muckt, versteck das Blatt einfach. Im Forum gibt es ein paar nette Beiträge, wie man ein Blatt "normal" versteckt, und wie man es mit VB "richtig böse" versteckt. Kann aber sein, daß das abhängig von der Excel-Version ist: ich tu grad mit 2000, und da ist das Verstecken von Blättern *nicht* im Kontextmenü vorhanden.

So, hier der Codeausschnitt:

Private Sub Worksheet_Change(ByVal Ziel As Excel.Range)
Dim ZielZelle, FundZelle As Range
Dim rngZelle As Range
Dim RegalZelle As String
Dim status As Integer
' ************* Nur zum Mitverfolgen, was passiert
MsgBox Ziel.AddressLocal
Set ZielZelle = Cells(Ziel.Row, Ziel.Column - 1)
status = Cells(Ziel.Row, Ziel.Column + 1).Value
MsgBox ZielZelle.AddressLocal & " " & ZielZelle.Value & "Status: " & status
' ************* Nur zum Mitverfolgen, was passiert
Set FundZelle = Sheets("Hilfsblatt").Range("RegalNamen").Find(What:=ZielZelle.Value, _
        LookIn:=xlValues, MatchCase:=False)
If FundZelle Is Nothing Then MsgBox "nicht gefunden"
' Hier bitte irgendwie Fehler abfangen
RegalZelle = Sheets("Hilfsblatt").Cells(FundZelle.Row, FundZelle.Column + 1).Value
' ************* Nur zum Mitverfolgen, was passiert
MsgBox "Regalzelle: " & RegalZelle

Set rngZelle = Range(RegalZelle)
        Select Case rngZelle.Value
            Case Is = ""
                rngZelle.Interior.Color = RGB(255, 255, 255)
            Case Is = "0"
                rngZelle.Interior.Color = RGB(0, 255, 0)
            Case Is = "Leihgerät"
                rngZelle.Interior.Color = RGB(255, 255, 153)
            Case Is = "Eigen"
                rngZelle.Interior.Color = RGB(255, 255, 153)
            Case Is < Range("W18")
                rngZelle.Interior.Color = RGB(255, 153, 204)
            Case Is > Range("W18")
               If status = 3 Then rngZelle.Interior.Color = RGB(255, 204, 153)
               If status = 4 Then rngZelle.Interior.Color = RGB(153, 153, 255)
               If (status <> 4) And (status <> 3) _
                  Then rngZelle.Interior.Color = RGB(255, 0, 0)
        End Select
    
End Sub
... und die Datei mit meinen minimalinvasiven Änderungen:
https://www.herber.de/bbs/user/93788.xls

Schreib mir, ob Du dafür ein "gut gemacht, Sabbelchen" gehört hast.

Schöne Grüße,

Michael

P.S.: Das worksheet_change ist ja ziemlich lästig! Wenn man *irgendwo* was eingibt, wird es auch aufgerufen! Das hat mich grad beim Testen schon genervt, könnte aber auch zu unvorhergesehenen Ergebnissen führen, wenn eben nicht links und rechts neben der Eingabezelle "sinnvolle" Werte stehen.

Abhilfe 1: Du schützt das Blatt schreib (oder wie man das formulieren will), damit keiner was eingeben kann, wo er nicht soll.
Abhilfe 2: Du machst ähnlich wie in der anderen Funktion eine target-Abfrage: wenn die Eingabe *nicht* in den lilanen Bereichen erfolgt, wird die ws_change verlassen.

Und das noch: Du mußt nicht tausend einzelne Bereiche zusammenfassen, denn mit der Strg-Taste kannst Du auch unzusammenhängende Bereiche mit der Maus markieren und ihnen in einem Rutsch auch einen Namen verpassen.


  

Betrifft: AW: Ich komme mit meiner Lagerdatei nicht weiter :( von: Sabrina
Geschrieben am: 15.11.2014 09:30:07

Huhu, Michael.

Vielen Dank.

Es kommt bei mir ein Laufzeitfehler wenn ich eine Zahl beim Status ( rechts neben der Lagernummer ) eingebe.

Was mache ich falsch?

LG

Sabbel


  

Betrifft: AW: Ich komme mit meiner Lagerdatei nicht weiter :( von: Sabrina
Geschrieben am: 15.11.2014 10:24:18

Achso, es sollte auch möglich sein, dass man den Status ändert und sich die Farbe dann dem entsprechend ändert.

LG

Sabbel


  

Betrifft: mein Fehler von: Michael
Geschrieben am: 16.11.2014 15:23:20

Hallo Sabbel,

die Tücke steckt im Detail. Ich schaue ja nur in der Spalte links der Eingabe nach der Regalbezeichnung, und wenn man den Status ändert, steht links daneben eben nicht das Regal, sondern der Wert.

Überhaupt hab ich die Geschichte überschlafen und denke, es geht auch eleganter, ohne Hilfsblatt.

Ich schau's mir gleich mal an und melde mich nochmal.

LG,

Michael


  

Betrifft: So, aber jetzt von: Michael
Geschrieben am: 16.11.2014 18:19:54

Hallo Sabbel,

ich hab das Ding nochmal überarbeitet und mehrere (nicht zusammenhängende) Bereiche mit Namen versehen. Dabei bin ich seltsamerweise darüber gestolpert, daß (zumindest) Excel (2000) scheinbar eine Grenze für die Anzahl der Teilbereich hat, und zwar 19 x 4 x zwei_zusammenhängende_Zellen, das sind 76 Bereiche bzw. 152 Zellen, Zahlen, die für Informatiker völlig unüblich sind, derweil sie so rein gar nichts mit 2er Potenzen zu tun haben.

Sei's drum, hab ich halt je zwei Bereiche definiert und mache die Abfrage auf beide, das tut auch.
Mit diesen Bereichen entfällt das Hilfsblatt:

Private Sub Worksheet_Change(ByVal Ziel As Excel.Range)
' Quellen u.a.
'  _
https://www.herber.de/forum/archiv/632to636/633563_Wie_funktioniertINTERSECT.html

' http://www. _
scheidgen.de/Excel/VBA/markierung_in_bereich_pruefen-01.htm


Dim FundZelle As Range
Dim rngZelle As Range
Dim RegalZelle, suchen As String
Dim status, spalte_links, farben, gefunden As Integer

status = 0
' ************* Fall 1: Anwender ändert Wert im rosa Bereich
If Not Application.Intersect(Ziel, Range("RosaRegalWert")) Is Nothing Then status = 1
' ************* Fall 2: Anwender ändert Status
If Not Application.Intersect(Ziel, Range("RegalStatus")) Is Nothing Then status = 2
' Wenn woanders was geändert wird, ist status unverändert =0
If status = 0 Then Exit Sub
' raus aus dem Programm!

spalte_links = status
' also 1 nach links, wenn rosa Wert bzw.
' 2 nach links, wenn Status eingegeben
suchen = Cells(Ziel.Row, Ziel.Column - spalte_links).Value
If status = 2 Then
   status = Cells(Ziel.Row, Ziel.Column).Value
  Else
   status = Cells(Ziel.Row, Ziel.Column + 1).Value
End If

gefunden = 0
Set FundZelle = Range("Beschriftung").Find(What:=suchen, _
        LookIn:=xlValues, MatchCase:=False)
If Not FundZelle Is Nothing Then
    gefunden = 1
  Else
    Set FundZelle = Range("Beschriftung2").Find(What:=suchen, _
            LookIn:=xlValues, MatchCase:=False)
    If Not FundZelle Is Nothing Then gefunden = 1
End If
' Hier bitte irgendwie Fehler abfangen
If gefunden = 0 Then
  MsgBox suchen & " nicht gefunden"
  Exit Sub
  End If
Set rngZelle = Cells(FundZelle.Row, FundZelle.Column + 1)
' MsgBox "rngZelle: " & rngZelle.Address

' Es folgt die Variante, die ich gemeint habe mit "Matrix" für Farben
        Select Case rngZelle.Value
            Case Is = ""
                farben = 1
            Case Is = "0"
                farben = 2
            Case Is = "Leihgerät"
                farben = 3
            Case Is = "Eigen"
                farben = 4
            Case Is < Range("W18")
                farben = 5
            Case Is > Range("W18")
               If status = 3 Then farben = 7
               If status = 4 Then farben = 8
               If (status <> 4) And (status <> 3) Then farben = 6
        End Select
   rngZelle.Interior.Color = Range("AI" & 12 + farben).Interior.Color
   ' holt sich einfach die Farbe aus der Matrix, d.h., Du kannst die Farben
   ' dort ändern, ohne Dich um die lästeign RGB-Werte kümmern zu müssen.
   ' Das Erweitern der Matrix ist programmiertechnisch auch ziemlich simpel.
End Sub
Weil ich schon dabei war, hab ich auch Bereiche für Deine zweite Funktion definiert: die wird dadurch deutlich kürzer.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
    Dim Lager As Long
    Dim status As Integer
    
 '   MsgBox Target.Address
    status = 0
    ' ************* A1 bis J7
    If Not Application.Intersect(Target, Range("RegalInhalt")) Is Nothing Then status = 1
    ' ************* J2 bis M8
    If Not Application.Intersect(Target, Range("ReaglInhalt2")) Is Nothing Then status = 2
    ' Wenn woanders geklickt wird, ist status unverändert =0
    If status = 0 Then Exit Sub
    ' hier gehört sich eine Abfrage rein, ob der Wert numerisch ist, sonst spuckts
    Lager = Target.Cells(1, 1).Value
    Range("W17") = Lager
    If Range("W17") > 0 Then
        MsgBox "call wird aufgerufen"
'        Call Lagr
        Else
        Range("A1").Select
        Exit Sub
    End If
    Cancel = True
End Sub
So, hier noch die Datei: https://www.herber.de/bbs/user/93802.xls

Happy Exceling,

Michael


 

Beiträge aus den Excel-Beispielen zum Thema "Ich komme mit meiner Lagerdatei nicht weiter :("