|
こんにちは
これで如何かな?
Sub kouji_1()
Dim rng As Range
Dim ans As Range
Dim crng As Range
Dim ccnt As Long
Dim idx As Long
On Error Resume Next
With Worksheets("アイテム")
Set rng = .Range("AB1", .Cells(Rows.Count, 28).End(xlUp))
End With
If rng.Count > 1 Then
With rng
Set ans = .SpecialCells(xlCellTypeConstants)
If Err.Number = 0 Then
ReDim myarray(1 To ans.Count)
ccnt = 0
For Each crng In ans
myarray(ccnt + 1) = Asc(crng.Value)
ccnt = ccnt + 1
Next
ReDim larray(1 To ccnt)
For idx = 1 To ccnt
larray(idx) = Application.Small(myarray(), idx)
larray(idx) = Chr(larray(idx))
Next
Worksheets("集計").Range("F4").Value = Join(larray(), "+")
End If
End With
Else
Worksheets("集計").Range("F4").Value = rng.Value
End If
On Error GoTo 0
End Sub
|
|