- 帖子
- 163
- 主題
- 1
- 精華
- 0
- 積分
- 170
- 點名
- 0
- 作業系統
- Window 7
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2010-9-5
- 最後登錄
- 2022-7-20
|
5#
發表於 2016-6-28 15:37
| 只看該作者
回復 1# simontasi
經整理後資料匯出B:D欄。- Sub test()
- Dim arr, brr()
- With ActiveSheet
- .Cells.Replace ChrB(160), ""
- er = .[A65536].End(3).Row
- arr = .Range("A1:A" & er)
- .[B1:D65536].ClearContents
- End With
- n = -1
- For i = 1 To UBound(arr)
- If InStr(arr(i, 1), "abc") <> 0 Then
- n = n + 1
- ReDim Preserve brr(2, n)
- brr(0, n) = arr(i, 1)
- c = 1
- Else
- If Right(arr(i, 1), 1) = "元" Then
- brr(c, n) = Val(arr(i, 1))
- c = c + 1
- End If
- End If
- Next i
- ActiveSheet.[B1].Resize(n + 1, 3) = Application.Transpose(brr)
- End Sub
複製代碼 |
|