26.07.2017, 20:30
Hallo!
Hab da wieder ein Problem.
Habe in meiner Uf einen Code der immer dasselbe macht, mit der ausnahme in einer anderen Zeile und spalte.
Ich habe bei diesen Code am anfanang alles nach einander geschrieben.
Mittlerweile auch über eine Schleife.
Soweit so gut, da der Code Teil sich immer wiederholt habe ich mir gedacht das dieser Code Teil nur einmal geschrieben werden sollte
und je nach Bediengung wieder durchlaufen wird.
Hier die Beschreibung
Beim Start von Excel wird die Uf WartAus aufgerufen, Links auf MaschinenAuswahl gehen und eine in der Box auswählen.
Auswahl getroffen, dann in der anderen Box "Analyse Hydrauliköl mit Filtromat OF5 mit FCU gegebenenfalls filtern bzw. wechseln"
auswählen, dann noch den Namen auswählen und den Button Bestätigen Clicken.
Wenn der Button Bestätigen angeclickt ist LÄUFT DER CODE ab wo ich das Problem habe.
Hier noch der Code
Und diese Zeilen wiederholen sich
Auch immer nach den zusätzlichen abfragen
Bei den zusätzlichen abfragen ändert sich das KurzW was dann angesprochen werden muß
Wie kann man den den Programm Teil Ständig wieder ansperchen
Hab da wieder ein Problem.
Habe in meiner Uf einen Code der immer dasselbe macht, mit der ausnahme in einer anderen Zeile und spalte.
Ich habe bei diesen Code am anfanang alles nach einander geschrieben.
Mittlerweile auch über eine Schleife.
Soweit so gut, da der Code Teil sich immer wiederholt habe ich mir gedacht das dieser Code Teil nur einmal geschrieben werden sollte
und je nach Bediengung wieder durchlaufen wird.
Hier die Beschreibung
Beim Start von Excel wird die Uf WartAus aufgerufen, Links auf MaschinenAuswahl gehen und eine in der Box auswählen.
Auswahl getroffen, dann in der anderen Box "Analyse Hydrauliköl mit Filtromat OF5 mit FCU gegebenenfalls filtern bzw. wechseln"
auswählen, dann noch den Namen auswählen und den Button Bestätigen Clicken.
Wenn der Button Bestätigen angeclickt ist LÄUFT DER CODE ab wo ich das Problem habe.
Hier noch der Code
Code:
Private Sub CommandButton2_Click()
Dim i, a As Integer
Dim vZeile As Variant
Dim iActSheet As Integer
Dim rngZelle As Range
Dim letztespalte As Range
Dim KurzW As String 'Kürzel für Wartung
Dim AktuellesDatum As Date
Dim komm As String
Dim rng As Range
Dim Zeile As Long
iActSheet = ActiveSheet.Index 'Merken welches Tabellenblatt aktiv ist
If MitArbeiter > "" Then
With WartAus.ListBox2
For i = 0 To .ListCount - 1 'Alle markierten ListBox-Einträge sammeln
If WartAus.ListBox2.Selected(i) = True Then
With ThisWorkbook.ActiveSheet
vZeile = Application.Match(ListBox2.List(i, 1), .Columns(2), 0)
Cells(vZeile, 8) = CDate(tbDatum)
Cells(vZeile, 8).Offset(0, 1).Value = MitArbeiter
KurzW = Cells(vZeile, 5).Value 'Kürzel der Wartung ermitteln
Set rngZelle = Range("M2:CP3").Find(KurzW, lookat:=xlWhole, LookIn:=xlValues) 'Nach Kürzel suchen
Cells(rngZelle.End(xlDown).Row + 1, rngZelle.End(xlDown).Column).Value = CDate(tbDatum)
Cells(rngZelle.End(xlDown).Row, rngZelle.End(xlDown).Column + 1).Value = MitArbeiter
If Cells(vZeile, 5).Value = "H_006" Then ' 'Wartung gefunden
If MsgBox("Wurde ein Ölwechsel oder Filterwechsel durch gefürt?", vbQuestion + vbYesNo, _
"Titeltext, vbExclamation") = vbYes Then
Wechsel.Show 'UF aufrufen
If Wechsel.Oelwe = True Then 'Oelwechsel+Filterwechsel
Unload Wechsel 'UF Schliesen
For a = 1 To 2
vZeile = vZeile + 1 'Für Name und Datum eine Zeile in der Tabelle weiter schalten
'Cells(vZeile, 8).Select 'Celle selktieren
Cells(vZeile, 8).Value = CDate(tbDatum) 'Datum eintragen
Cells(vZeile, 8).Offset(0, 1).Value = MitArbeiter 'Mit Arbeiter eintragen
KurzW = Cells(vZeile, 5).Value '"H_007" 'Kürzel der Wartung ermitteln Ölwechsel
Set rngZelle = Range("M2:CP3").Find(KurzW, lookat:=xlWhole, LookIn:=xlValues) 'Nach Kürzel suchen
'rngZelle.End(xlDown).Select
Cells(rngZelle.End(xlDown).Row + 1, rngZelle.End(xlDown).Column).Value = CDate(tbDatum)
Cells(rngZelle.End(xlDown).Row, rngZelle.End(xlDown).Column + 1).Value = MitArbeiter
Next a
Else 'Filterwechsel
vZeile = vZeile + 2
Cells(vZeile, 8).Select
Cells(vZeile, 8).Value = CDate(tbDatum)
Cells(vZeile, 8).Offset(0, 1).Value = MitArbeiter
KurzW = Cells(vZeile, 5).Value '"H_008" 'Kürzel der Wartung ermitteln Filterwechsel
Set rngZelle = Range("M2:CP3").Find(KurzW, lookat:=xlWhole, LookIn:=xlValues) 'Nach Kürzel suchen
Cells(rngZelle.End(xlDown).Row + 1, rngZelle.End(xlDown).Column).Value = CDate(tbDatum)
Cells(rngZelle.End(xlDown).Row, rngZelle.End(xlDown).Column + 1).Value = MitArbeiter
End If
Else
MsgBox "Nein"
Oelkontrolle.Show
End If
End If
'hier muss dann abgefragt werden ob es einen Kommentar gibt
Set rng = Range("A:A").Find(KurzW)
If rng Is Nothing Then
'MsgBox "Wert " & KurzW & " nicht gefunden!"
Else
komm = rng.Offset(0, 1)
'rngZelle.End(xlDown).Select
With .Cells(rngZelle.End(xlDown).Row, rngZelle.End(xlDown).Column + 1)
.ClearComments
.AddComment
.Comment.Visible = False
.Comment.Text Text:=komm '& Chr(10) & ""
.Comment.Shape.TextFrame.AutoSize = True ' Größe automatisch festlegen
End With
'Löschen des Wortes
Zeile = Columns("A:A").Find(KurzW, LookIn:=xlFormulas, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
Range(Cells(Zeile, "A"), Cells(Zeile, "B")).Select
Selection.Delete Shift:=xlUp
End If
End With
WartAus.ListBox2.Selected(i) = False
End If
Next i
End With
Else
MsgBox "Kein Name ausgewählt"
Exit Sub
End If
Call DatumAk
Call Zellenfarbe
Call Seitennamen
AktuellesDatum = Date
WartAus.Frame1.Clear
Call colorC1
ThisWorkbook.Sheets(iActSheet).Activate 'Tabellenblatt wieder aktivieren
Call suchenSpA
End SubUnd diese Zeilen wiederholen sich
Code:
Cells(vZeile, 8).Select
Cells(vZeile, 8).Value = CDate(tbDatum)
Cells(vZeile, 8).Offset(0, 1).Value = MitArbeiter
KurzW = Cells(vZeile, 5).Value '"H_008" 'Kürzel der Wartung ermitteln Filterwechsel
Set rngZelle = Range("M2:CP3").Find(KurzW, lookat:=xlWhole, LookIn:=xlValues) 'Nach Kürzel suchen
Cells(rngZelle.End(xlDown).Row + 1, rngZelle.End(xlDown).Column).Value = CDate(tbDatum)
Cells(rngZelle.End(xlDown).Row, rngZelle.End(xlDown).Column + 1).Value = MitArbeiterBei den zusätzlichen abfragen ändert sich das KurzW was dann angesprochen werden muß
Wie kann man den den Programm Teil Ständig wieder ansperchen
mfg
Michael
:98:
WIN 10 Office 2019
Michael
:98:
WIN 10 Office 2019