All pastes #391076 Raw Edit

Miscellany

public text v1 · immutable
·published 2007-03-11 21:49 UTC
rendered paste body
'----------------------------Variablen
Dim Count As Long
'Arrays deklarieren
Dim Schadstoff() 'Array der Schdstoffkenzahl im Kundensatamm
Dim Motor() ' Kenzahl des Motortyps (Verbrennung) im Kundenstamm
Dim Pfadalle
Dim Suchwert




Private Sub bEinstufen_Click()
'Emittelt die Schdstoff Klassifizierung
XLSEinlesen
ac = 0
For X = 1 To Count
    ac = ac + 1
    If Motor(ac) = "B" Then
    Suchwert = Schadstoff(ac)
    MsgBox "gesucht wird nach" & Schadstoff(ac)
    Benziner
    Else
    Diesel
    Suchwert = Schadstoff(ac)
    End If
Next X
End Sub
Private Sub bTextlesen_Click()
Texteinlesen
'MsgBox DEuro1(6)
End Sub
Private Sub bEinlesen_Click()


XLSEinlesen
End Sub
Sub XLSEinlesen() 'liest die eingegebenen der spalten G und H werte in variablen

Count = (Cells.SpecialCells(xlLastCell).Row) 'Anzahl der Zeilen werden ermittelt
ReDim Preserve Schadstoff(Count) 'schadstoff Array auf passende größe Dimensionieren
ReDim Preserve Motor(Count)      'Motorarray domensionieren
SC = 0

For I = 1 To Count
        SC = SC + 1
        Schadstoff(SC) = Range("g" & SC).Value
        Motor(SC) = Range("h" & SC).Value
Next I
'Hilfsanweisung um zu sehen was in Schadstoff array ist
'For a = 1 To Count
'counter = counter + 1
'ausgabe = ausgabe & Schadstoff(counter) & vbCrLf
'Next a
'MsgBox ausgabe
End Sub



Sub Benziner()
XLSEinlesen
Pfadalle = ThisWorkbook.Path

' die alle in ein array
Pfadeuro1 = Pfadalle & "\Benzin_Euro1.txt"
Pfadeuro2 = Pfadalle & "\Benzin_Euro2.txt"
Pfadeuro3 = Pfadalle & "\Benzin_Euro3.txt"
Pfadeuro4 = Pfadalle & "\Benzin_Euro4.txt"
'--------------------------------------

for f to 4
    Open Pfadeuro(f) For Input As #1
    Do While Not EOF(1)
        Line Input #1, sLine
        If Instr(sLine, Suchwert, 1) > 0 then
            MsgBox "Fahrzeug ist ein Euro 1 Fahrzeug"
        Else
            MsgBox "Fahrzeug is kein Euro 1 Fahrzeug"
        End If
next f
Loop
Close #1

End Sub
Sub Diesel()
msdbox "nix"
End Sub