|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Option Explicit
- '问题1
- Sub Test1()
- Dim Rg As Range, lngRow As Long
- Dim arr As Variant
- On Error Resume Next
- Set Rg = Application.InputBox("请选择需要合并内容的单元格", Type:=8)
- If Rg Is Nothing Then Err.Clear: Exit Sub
-
- If Rg.Column <> 2 Then Exit Sub
-
- arr = Rg
-
- For lngRow = LBound(arr) To UBound(arr)
- arr(lngRow, 1) = arr(lngRow, 1) & arr(lngRow, 2)
- arr(lngRow, 2) = ""
- Next
-
- Rg = arr
- End Sub
- '问题2
- Sub Test()
- Dim SH As Worksheet, Rg As Range
- Dim strTemp As String
- Dim lngLen As Long
- Dim lngIndex As Long, lngColorIndex As Long
- Dim strColor As String
-
- Set SH = Sheet1
- Set Rg = SH.Range("B18")
- strTemp = Rg.Value
-
- lngLen = Len(strTemp)
-
- For lngIndex = 1 To lngLen
- lngColorIndex = Rg.Characters(lngIndex, 1).Font.ColorIndex
- If lngColorIndex <> 1 And lngColorIndex <> -4105 Then
- strColor = strColor & Mid(strTemp, lngIndex, 1)
- End If
- Next
-
- MsgBox "有颜色的字符为:【" & strColor & "】"
-
- strTemp = Replace(strTemp, strColor, "[前面加了东东]" & strColor & "【前面加了东东】")
-
- Rg.Value = strTemp
- End Sub
复制代码 |
|