Vielleicht habe ich nur was übersehen?!?!
30.09.2008 09:44:00
Tobias
Ich lasse den CpK Werte berechnen und benutze dazu eine Auswahl die die Werte -1000 filtert. Bei meinem Quellcode funktioniert das komischer Weise nur bei Werte 1,3,5,7,9 aber nicht bei 2,4,6,8. Warum?
Danke Tobias
Quellcode ist unten angehängt:
'1
Dim ra As Range, iRow As Integer
''nach der 1. Wert -1000 suchen
iRow = 0
Set ra = ActiveSheet.Range("B1:B100").Find(-1000, , xlValues, xlWhole, xlByRows, xlNext)
If Not ra Is Nothing Then
iRow = 108 - ra.Row
Else
iRow = 7
End If
Range("B105").FormulaR1C1 = Cpk_RT_unten 'untere Grenze des CpK-Werts
Range("B106").FormulaR1C1 = Cpk_RT_oben 'oberer Grenze des CpK-Werts
Range("B107").FormulaR1C1 = "=AVERAGE(R[-106]C:R[-" & iRow & "]C)"
Range("B108").FormulaR1C1 = "=STDEV(R[-107]C:R[-" & iRow + 1 & "]C)"
Range("B109").FormulaR1C1 = _
"=MIN((R[-2]C-R[-4]C)/(3*R[-1]C),(R[-3]C-R[-2]C)/(3*R[-1]C))"
Range("B105:B109").NumberFormat = "0.00"
Range("B107").Select
'2
Dim rb As Range
''nach der 1. Wert -1000 suchen
iRow = 0
Set rb = ActiveSheet.Range("F1:F100").Find(-1000, , xlValues, xlWhole, xlByRows, xlNext)
If Not rb Is Nothing Then
iRow = 108 - rb.Row
Else
iRow = 7
End If
Range("F105").FormulaR1C1 = Cpk_LT_unten 'untere Grenze des CpK-Werts
Range("F106").FormulaR1C1 = Cpk_LT_oben 'oberer Grenze des CpK-Werts
Range("F107").FormulaR1C1 = "=AVERAGE(R[-106]C:R[-" & iRow & "]C)"
Range("F108").FormulaR1C1 = "=STDEV(R[-107]C:R[-" & iRow + 1 & "]C)"
Range("F109").FormulaR1C1 = _
"=MIN((R[-2]C-R[-4]C)/(3*R[-1]C),(R[-3]C-R[-2]C)/(3*R[-1]C))"
Range("F105:F109").NumberFormat = "0.00"
Range("F107").Select
'3
Dim rc As Range
''nach der 1. Wert -1000 suchen
iRow = 0
Set rc = ActiveSheet.Range("J1:J100").Find(-1000, , xlValues, xlWhole, xlByRows, xlNext)
If Not rc Is Nothing Then
iRow = 108 - rc.Row
Else
iRow = 7
End If
Range("J105").FormulaR1C1 = Cpk_HT_unten 'untere Grenze des CpK-Werts
Range("J106").FormulaR1C1 = Cpk_HT_oben 'oberer Grenze des CpK-Werts
Range("J107").FormulaR1C1 = "=AVERAGE(R[-106]C:R[-" & iRow & "]C)"
Range("J108").FormulaR1C1 = "=STDEV(R[-107]C:R[-" & iRow + 1 & "]C)"
Range("J109").FormulaR1C1 = _
"=MIN((R[-2]C-R[-4]C)/(3*R[-1]C),(R[-3]C-R[-2]C)/(3*R[-1]C))"
Range("J105:J109").NumberFormat = "0.00"
Range("J107").Select
'4
' Dim rd As Range
''nach der 1. Wert -1000 suchen
iRow = 0
Set rd = ActiveSheet.Range("N1:N100").Find(-1000, , xlValues, xlWhole, xlByRows, xlNext)
If Not rd Is Nothing Then
iRow = 108 - rd.Row
Else
iRow = 7
End If
Range("N105").FormulaR1C1 = Cpk_RT_unten 'untere Grenze des CpK-Werts
Range("N106").FormulaR1C1 = Cpk_RT_oben 'oberer Grenze des CpK-Werts
Range("N107").FormulaR1C1 = "=AVERAGE(R[-106]C:R[-" & iRow & "]C)"
Range("N108").FormulaR1C1 = "=STDEV(R[-107]C:R[-" & iRow + 1 & "]C)"
Range("N109").FormulaR1C1 = _
"=MIN((R[-2]C-R[-4]C)/(3*R[-1]C),(R[-3]C-R[-2]C)/(3*R[-1]C))"
Range("N105:N109").NumberFormat = "0.00"
Range("N107").Select
'5
Dim re As Range
''nach der 1. Wert -1000 suchen
iRow = 0
Set re = ActiveSheet.Range("R1:R100").Find(-1000, , xlValues, xlWhole, xlByRows, xlNext)
If Not re Is Nothing Then
iRow = 108 - re.Row
Else
iRow = 7
End If
Range("R105").FormulaR1C1 = Cpk_LT_unten 'untere Grenze des CpK-Werts
Range("R106").FormulaR1C1 = Cpk_LT_oben 'oberer Grenze des CpK-Werts
Range("R107").FormulaR1C1 = "=AVERAGE(R[-106]C:R[-" & iRow & "]C)"
Range("R108").FormulaR1C1 = "=STDEV(R[-107]C:R[-" & iRow + 1 & "]C)"
Range("R109").FormulaR1C1 = _
"=MIN((R[-2]C-R[-4]C)/(3*R[-1]C),(R[-3]C-R[-2]C)/(3*R[-1]C))"
Range("R105:R109").NumberFormat = "0.00"
Range("R107").Select
'6
Dim rf As Range
''nach der 1. Wert -1000 suchen
iRow = 0
Set rf = ActiveSheet.Range("V1:V100").Find(-1000, , xlValues, xlWhole, xlByRows, xlNext)
If Not rf Is Nothing Then
iRow = 108 - rf.Row
Else
iRow = 7
End If
Range("V105").FormulaR1C1 = Cpk_HT_unten 'untere Grenze des CpK-Werts
Range("V106").FormulaR1C1 = Cpk_HT_oben 'oberer Grenze des CpK-Werts
Range("V107").FormulaR1C1 = "=AVERAGE(R[-106]C:R[-" & iRow & "]C)"
Range("V108").FormulaR1C1 = "=STDEV(R[-107]C:R[-" & iRow + 1 & "]C)"
Range("V109").FormulaR1C1 = _
"=MIN((R[-2]C-R[-4]C)/(3*R[-1]C),(R[-3]C-R[-2]C)/(3*R[-1]C))"
Range("V105:V109").NumberFormat = "0.00"
Range("V107").Select
'7
Dim rg As Range
''nach der 1. Wert -1000 suchen
iRow = 0
Set rg = ActiveSheet.Range("Z1:Z100").Find(-1000, , xlValues, xlWhole, xlByRows, xlNext)
If Not rg Is Nothing Then
iRow = 108 - rg.Row
Else
iRow = 7
End If
Range("Z105").FormulaR1C1 = Cpk_RT_unten 'untere Grenze des CpK-Werts
Range("Z106").FormulaR1C1 = Cpk_RT_oben 'oberer Grenze des CpK-Werts
Range("Z107").FormulaR1C1 = "=AVERAGE(R[-106]C:R[-" & iRow & "]C)"
Range("Z108").FormulaR1C1 = "=STDEV(R[-107]C:R[-" & iRow + 1 & "]C)"
Range("Z109").FormulaR1C1 = _
"=MIN((R[-2]C-R[-4]C)/(3*R[-1]C),(R[-3]C-R[-2]C)/(3*R[-1]C))"
Range("Z105:Z109").NumberFormat = "0.00"
Range("Z107").Select
'8
Dim rh As Range
''nach der 1. Wert -1000 suchen
iRow = 0
Set rh = ActiveSheet.Range("AD1:AD100").Find(-1000, , xlValues, xlWhole, xlByRows, xlNext)
If Not rh Is Nothing Then
iRow = 108 - rh.Row
Else
iRow = 7
End If
Range("AD105").FormulaR1C1 = Cpk_LT_unten 'untere Grenze des CpK-Werts
Range("AD106").FormulaR1C1 = Cpk_LT_oben 'oberer Grenze des CpK-Werts
Range("AD107").FormulaR1C1 = "=AVERAGE(R[-106]C:R[-" & iRow & "]C)"
Range("AD108").FormulaR1C1 = "=STDEV(R[-107]C:R[-" & iRow + 1 & "]C)"
Range("AD109").FormulaR1C1 = _
"=MIN((R[-2]C-R[-4]C)/(3*R[-1]C),(R[-3]C-R[-2]C)/(3*R[-1]C))"
Range("AD105:AD109").NumberFormat = "0.00"
Range("AD107").Select
'9
' Dim ri As Range
''nach der 1. Wert -1000 suchen
iRow = 0
Set ri = ActiveSheet.Range("AH1:AH100").Find(-1000, , xlValues, xlWhole, xlByRows, xlNext)
If Not ri Is Nothing Then
iRow = 108 - ri.Row
Else
iRow = 7
End If
Range("AH105").FormulaR1C1 = Cpk_HT_unten 'untere Grenze des CpK-Werts
Range("AH106").FormulaR1C1 = Cpk_HT_oben 'oberer Grenze des CpK-Werts
Range("AH107").FormulaR1C1 = "=AVERAGE(R[-106]C:R[-" & iRow & "]C)"
Range("AH108").FormulaR1C1 = "=STDEV(R[-107]C:R[-" & iRow + 1 & "]C)"
Range("AH109").FormulaR1C1 = _
"=MIN((R[-2]C-R[-4]C)/(3*R[-1]C),(R[-3]C-R[-2]C)/(3*R[-1]C))"
Range("AH105:AH109").NumberFormat = "0.00"
Range("AH107").Select