ohne Select und Markieren
27.09.2009 23:59:57
Erich
Hi Larissa,
probiers mal damit:
Public Sub Kurs()
Dim varV, lngB As Long, arrW
varV = Application.Match(Cells(1, 11), Columns(2), 0)
If IsNumeric(varV) Then
lngB = varV
While Cells(lngB, 2) = Cells(1, 11)
If Cells(lngB, 6).NumberFormat "#,##0.00 [$$-409]" Then ' Formatprüfung
MsgBox "Zelle " & Cells(lngB, 6).Address(0, 0) & _
" hat nicht Format #,##0.00 [$$-409]", vbCritical, "Abbruch"
Exit Sub
End If
lngB = lngB + 1
Wend
With Cells(varV, 6).Resize(lngB - varV) ' betroffener Bereich
arrW = Application.Transpose(.Value) ' einlesen in Array
For lngB = 1 To UBound(arrW) ' umrechnen
arrW(lngB) = Application.Round(arrW(lngB) / Cells(2, 11), 2)
Next lngB
.NumberFormat = "#,##0.00" ' Zahlenformat
.Value = Application.Transpose(arrW) ' zurückschreiben
End With
Else
MsgBox "Beleg-Nr '" & Cells(1, 11) & "' wurde in Spalte B nicht gefunden", _
vbCritical, "Abbruch"
End If
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort