|
Function vvv(sel0 As Range) As Range
wb0 = sel0.Parent.Parent.Name 'get workbook.name
sh0 = sel0.Worksheet.Name 'get worksheet.name
a = Application.WorksheetFunction.CountA(sel0)
b = Application.WorksheetFunction.CountBlank(sel0)
n = a + b
Dim num()
ReDim num(n)
'****************************
i = 0
For Each s In sel0
i = i + 1
If IsNumeric(s) Then
num(i) = 1
Else: num(i) = 0
End If
Next
'*****************************
Set sel1 = Workbooks(wb0).Worksheets(sh0).UsedRange
col0 = sel1.Column + sel1.Columns.Count + 1
For i = 1 To n
If sel0.Columns.Count > sel0.Rows.Count Then
c = 0
d = i - 1
Else
c = i - 1
d = 0
End If
If i = 1 And num(i) = 1 Then
str0 = sel0.Offset(c, c).Resize(1, 1).Address
End If
If i = 1 And num(i) = 0 Then
str0 = sel0.Offset(i - 1, col0 - sel0.Column).Resize(1, 1).Address
End If
If i > 1 And i < n Then
If num(i - 1) = 1 And num(i) = 1 And num(i + 1) = 0 Then str0 = str0 & ":" & sel0.Offset(c, d).Resize(1, 1).Address
If num(i) = 1 And num(i - 1) = 0 Then str0 = str0 & "," & sel0.Offset(c, d).Resize(1, 1).Address
If num(i - 1) = 0 And num(i) = 0 And num(i + 1) = 1 Then str0 = str0 & ":" _
& sel0.Offset(i - 1, col0 - sel0.Column).Resize(1, 1).Address
If num(i) = 0 And num(i - 1) = 1 Then str0 = str0 & "," & sel0.Offset(i - 1, col0 - sel0.Column).Resize(1, 1).Address
End If
If i = n Then
If num(i - 1) = 1 And num(i) = 1 Then str0 = str0 & ":" & sel0.Offset(c, d).Resize(1, 1).Address
If num(i) = 1 And num(i - 1) = 0 Then str0 = str0 & "," & sel0.Offset(c, d).Resize(1, 1).Address
If num(i - 1) = 0 And num(i) = 0 Then str0 = str0 & ":" & sel0.Offset(i - 1, col0 - sel0.Column).Resize(1, 1).Address
If num(i - 1) = 1 And num(i) = 0 Then str0 = str0 & "," & sel0.Offset(i - 1, col0 - sel0.Column).Resize(1, 1).Address
End If
Next
Set vvv = Workbooks(wb0).Sheets(sh0).Range(str0)
End Function
|
|