elninoslov píše:Makro na prevod:Kód: Vybrat vše
Sub Prevod()
Dim R As Long, D(), S() As String, i As Long, x As Byte, n As Byte, CE As Long, COK As Long, bPrevod As Boolean, C As Double
With ThisWorkbook.ActiveSheet
R = .Cells(Rows.Count, 1).End(xlUp).Row - 9
D = .Cells(10, 3).Resize(R, 20).Value2
On Error Resume Next
For i = 1 To R
For x = 1 To 20
If Not IsEmpty(D(i, x)) Then
If Not IsNumeric(D(i, x)) Then
S = Split(D(i, x), ".")
If UBound(S) = 1 Then
If Not IsNumeric(S(0)) Then S(0) = WorksheetFunction.Arabic(S(0))
If Not IsNumeric(S(1)) Then S(1) = WorksheetFunction.Arabic(S(1))
C = Val(S(0) & "." & S(1))
bPrevod = Err.Number = 0
Else
bPrevod = False
End If
If bPrevod Then D(i, x) = C: COK = COK + 1 Else: CE = CE + 1: Err.Clear
End If
End If
Next x
Next i
.Cells(10, 3).Resize(R, 20).Value2 = D
MsgBox "Prevedených hodnôt : " & COK & vbNewLine & "Neprevedených hodnôt : " & CE
End With
End Sub
Moc ti děkuji, pomohlo to!! Fakt děkuji, velice jsem to potřeboval!
Téma uzavírám, děkuji všem za nápady a pomoc.
PS: Elninoslov, budu tě kontaktovat do PM, mám otázku prosím.