Function funktioniert nicht richtig
08.01.2018 15:38:47
Burak
also habe hier mit eurer Hilfe eine Function grundsätzlich zum Laufen gekriegt, aber bin nicht zufrieden mit den Werten, die dabei rauskommen.
Ich versuche unwichtige Stellen rauszufiltern, da der Code etwas lang ist:
Option Explicit
Dim startdatum As Date
Dim enddatum As Date
Dim bauteilFehlt As Integer
Dim fehlalarm As Integer
Dim xray As Integer
Dim bauteilFalsch As Integer
Dim loetfehler As Integer
Dim kurzschluss As Integer
Dim erfolgreich As Integer
Dim polaritaet As Integer
Dim keinAOI As Integer
Dim barcode As String
Dim bauteil As String
Dim Zeilenzahl As Long
Dim fehlercode As Integer
Dim pmtol As Integer
Dim pmschmutz As Integer
Dim pmopt As Integer
Dim lbfkbc As Integer
Dim lbfkks As Integer
Dim lbfkhp As Integer
Dim lbfktp As Integer
Dim lbbtv As Integer
Dim lbbtvorpin As Integer
Dim btpinverbogenlief As Integer
Dim btpinverbogenma As Integer
Dim btkopfl As Integer
Dim btvbp As Integer
Dim btvfkbc As Integer
Dim btvfkks As Integer
Dim btvfkhp As Integer
Dim btvfktp As Integer
Dim btvopt As Integer
Dim lfpadschmutz As Integer
Dim lfbtdefekt As Integer
Dim lfschatt As Integer
Dim lfpadkrizz As Integer
Dim tsdv As Integer
Dim tsbv As Integer
Dim tsfkbc As Integer
Dim tsfkks As Integer
Dim tsfkhp As Integer
Dim tsfktp As Integer
Dim btfbp As Integer
Dim btfp As Integer
Dim btfopt As Integer
Dim pfma As Integer
Dim pftol As Integer
Dim gfdef As Integer
Dim gftol As Integer
Dim kdpassa As Integer
Dim kdhandl As Integer
Dim kdvaga As Integer
Dim kdfk As Integer
Dim ufneu As Integer
Dim ufneuma As Integer
Dim zaehlen As Integer
Private Sub CommandButton1_Click()
'Keine Eingabe filtern
If Me.TextBox3 = "" And Me.TextBox4 = "" And Me.TextBox5 = "" Then
MsgBox ("Sie müssen entweder einen Barcode, ein Bauteil oder ein Fehlertyp eingeben!")
Exit Sub
End If
'Ungewünschte Mehrfacheingaben filtern
If Me.TextBox3 "" And Me.TextBox5 "" Or Me.TextBox4 "" And Me.TextBox5 "" Then
MsgBox "Der Filter Fehlercode ist nur alleine anwendbar.", 48, " Hinweis für " & _
Application.UserName
Exit Sub
End If
'Barcode
'Bedingung wenn befüllt dann numerisch
If Me.TextBox3 "" And Not IsNumeric(Me.TextBox3.Value) Then
MsgBox "Der Barcode ist numerisch einzugeben.", 48, " Hinweis für " & Application. _
UserName
With Me.TextBox3
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
Exit Sub
End If
'Bedingung wenn befüllt dann 4-stellig
If Me.TextBox3 "" And Me.TextBox3.TextLength 4 Then
MsgBox "Der Barcode ist nicht 4-stellig! Bitte korrigieren!", 48, " Hinweis für " & _
Application.UserName
With Me.TextBox3
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
Exit Sub
End If
'Gefüllte Textfelder als Variablen speichern
If Me.TextBox3 "" Then
barcode = Me.TextBox3.Value
End If
If Me.TextBox4 "" Then
bauteil = Me.TextBox4.Value
End If
If Me.TextBox5 "" Then
fehlercode = Me.TextBox5.Value
End If
'Nicht-leere Zeilen zählen
Range("B1").Select
Zeilenzahl = Selection.CurrentRegion.Rows.Count
If Me.TextBox3 "" And Me.TextBox4 "" Then
ElseIf Me.TextBox3 "" Then
'Zählen in AOI-Daten
bauteilFehlt = zaehlenbch("=1")
xray = zaehlenbch("=26")
bauteilFalsch = zaehlenbch("=3")
loetfehler = zaehlenbch("=6")
kurzschluss = zaehlenbch("=9")
polaritaet = zaehlenbch("=25")
keinAOI = zaehlenbch("=-1")
fehlalarm = zaehlenbch("=0")
MsgBox (fehlalarm)
erfolgreich = zaehlenbch("=")
MsgBox (erfolgreich)
'Zählen in Reparatur-Daten
Worksheets("LogImport").Activate
Range("B1").Select
Zeilenzahl = Selection.CurrentRegion.Rows.Count
pmtol = zaehlenbcg("=111")
pmschmutz = zaehlenbcg("=112")
pmopt = zaehlenbcg("=113")
lbfkbc = zaehlenbcg("=201")
lbfkks = zaehlenbcg("=202")
lbfkhp = zaehlenbcg("=203")
lbfktp = zaehlenbcg("=204")
lbbtv = zaehlenbcg("=205")
lbbtvorpin = zaehlenbcg("=211")
btpinverbogenlief = zaehlenbcg("=301")
btpinverbogenma = zaehlenbcg("=302")
btkopfl = zaehlenbcg("=303")
btvbp = zaehlenbcg("=304")
btvfkbc = zaehlenbcg("=305")
btvfkks = zaehlenbcg("=306")
btvfkhp = zaehlenbcg("=307")
btvfktp = zaehlenbcg("=308")
btvopt = zaehlenbcg("=311")
lfpadschmutz = zaehlenbcg("=401")
lfbtdefekt = zaehlenbcg("=402")
lfschatt = zaehlenbcg("=411")
lfpadkrizz = zaehlenbcg("=412")
tsdv = zaehlenbcg("=501")
tsbv = zaehlenbcg("=502")
tsfkbc = zaehlenbcg("=503")
tsfkks = zaehlenbcg("=504")
tsfkhp = zaehlenbcg("=505")
tsfktp = zaehlenbcg("=506")
btfbp = zaehlenbcg("=601")
btfp = zaehlenbcg("=602")
btfopt = zaehlenbcg("=611")
pfma = zaehlenbcg("=701")
pftol = zaehlenbcg("=711")
gfdef = zaehlenbcg("=801")
gftol = zaehlenbcg("=811")
kdpassa = zaehlenbcg("=901")
kdhandl = zaehlenbcg("=902")
kdvaga = zaehlenbcg("=903")
kdfk = zaehlenbcg("=904")
ufneu = zaehlenbcg("=X01")
ufneuma = zaehlenbcg("=X11")
'Tabellenblatt für Auswertung clearen
Call clearen
Range("B1").Value = "'" & Left(barcode, 3) & "." & Right(barcode, 1)
Range("A1").Value = "Barcode:"
Function zaehlenbcg(x As String) As Integer
zaehlen = WorksheetFunction.CountIfs(Range("A2:A" & Zeilenzahl), barcode, Range("G2:G" & _
Zeilenzahl), x)
End Function
Function zaehlenbch(x As String) As Integer
zaehlen = WorksheetFunction.CountIfs(Range("A2:A" & Zeilenzahl), barcode, Range("H2:H" & _
Zeilenzahl), x)
End Function
Private Sub clearen()
Worksheets("FilterGrafik").Activate
ActiveSheet.Select
Cells.Select
Selection.Clear
End Sub
erfolgreich = zaehlenbch("=")
etc kriege ich für jede Zeile den Wert 0, auch wenn in der Funktion selber für diesen Wert eine andere Zahl kommt.
Beispiel wie es sein soll:
Gebe in TextBox3 3333 ein.
Er kontrolliert in Spalte A überall wo ne 3333 steht, guckt dann in Spalte H ob er eins der Codes findet (3, 6, 25, -1 usw). Wenn ja soll er es zählen und es in die zugehörige Variable schreiben. Bei "fehlalarm" "=0" kommen etwa 72 raus. IN der funktion kriege ich über msgbox(zaehlen) die 72 angezeigt, aber nach dem ausführen der funktion über msgbox(fehlalarm) nur ne 0.
Wo liegt mein Denkfehler?
Freundliche Grüße