Kód: Vybrat vše
Sub prevod_dat()
Dim D(), V(), R As Long, Poz As Long, rngBold As Range, rngItalic As Range
D = Worksheets("takhle to dostanu").UsedRange.Value
ReDim V(1 To UBound(D, 1), 1 To 5)
With Worksheets("makro")
For R = 1 To UBound(D, 1)
If IsEmpty(D(R, 4)) Then
Poz = R
Else
If Not IsEmpty(D(R, 1)) Then
V(R, 1) = D(Poz, 1)
V(R, 2) = D(R, 1)
If rngBold Is Nothing Then Set rngBold = .Cells(R, 1) Else Set rngBold = Union(rngBold, .Cells(R, 1))
Else
Set rngBold = Union(rngBold, .Cells(R, 5))
If rngItalic Is Nothing Then Set rngItalic = .Cells(R, 5) Else Set rngItalic = Union(rngItalic, .Cells(R, 5))
End If
V(R, 5) = D(R, 4)
End If
Next R
.UsedRange.Clear
.Cells(1, 1).Resize(UBound(V, 1), 5).Value = V
rngBold.Font.Bold = True
rngItalic.Font.Italic = True
With .Cells(1, 1).Resize(UBound(V, 1), 5)
.Font.Name = "Verdana"
.Font.Size = 8
.Columns(5).NumberFormat = "#,##0.00"
End With
End With
End Sub