Sub kTest()
Dim ka, k(), i As Long, c As Long, n As Long
With ActiveSheet.UsedRange
ka = .Value
ReDim k(1 To UBound(ka, 1), 1 To UBound(ka, 2))
If IsArray(ka) Then
For i = 1 To UBound(ka, 1)
If Len(ka(i, 3)) = 0 Then
If IsNumeric(ka(i, 1)) Then
k(n, 1) = ka(i, 1): GoTo Nxt
End If
End If
If ((IsNumeric(ka(i, 3))) * (Right$(Cells(i, 3).NumberFormat, 1) = "%") * _
(Not IsNumeric(ka(i, 1)))) Then
k(n, 1) = Trim$(k(n, 1) & " " & ka(i, 1))
n = n + 1: For c = 2 To UBound(ka, 2): k(n, c) = ka(i, c): Next
Else
n = n + 1: For c = 1 To UBound(ka, 2): k(n, c) = ka(i, c): Next
End If
Nxt:
Next
End If
.ClearContents
.Cells(1).Resize(n, UBound(ka, 2)).Value = k
End With
End Sub
|