|
发表于 2015-1-15 16:07
来自手机
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub test()
Dim rng As Range
On Error Resume Next
Set rng = Application.InputBox("请选择要处理的数据区域", "指定数据", , , , , , 8)
If Err <> 0 Then Exit Sub
rng.TextToColumns Destination:=Range("AAR1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=TrueDim arr1, i As Integer, arr2(), js As Integer, outputrng As Range
arr1 = Range("AAR1").CurrentRegion.Value
For i = 1 To UBound(arr1)
js = js + 1
ReDim Preserve arr2(1 To 1, 1 To js)
If CLng(arr1(i, 1)) > 0 Then
If CLng(arr1(i, 2)) > 0 Then
arr2(1, js) = "'" & arr1(i, 1) & "年" & arr1(i, 2) & "个月"
Else
arr2(1, js) = "'" & arr1(i, 1) & "年"
End If
Else
arr2(1, js) = "'" & arr1(i, 2) & "个月"
End If
Next i
Set outputrng = Application.InputBox("请选择数据输出区域", "指定区域", , , , , , 8)
If Err <> 0 Then Exit Sub
outputrng(1).Resize(js, 1) = WorksheetFunction.Transpose(arr2)
Range("AAR1").CurrentRegion.Clear
End Sub |
|