一、excel中使用vba程序对某个区域的数据和文本随机进行字体和字号处理

代码如下，详见附件。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   Dim Ra As Range

   For Each Ra In Target

      Randomize

      Ra.Font.Name = Choose(Int(Rnd() * 9 + 1), 仿宋_GB2312, Arial Unicode MS, 宋体, 黑体, 幼圆, 隶书, Batang, Dotum, MS PGothic)

      Ra.Font.Size = Int(48 * Rnd() + 6)

   Next

End Sub

二、Excel用VBA 处理数据 第一列名字相同的行以TXT格式存放

用下面代码试试吧

Sub 保存为文本()

lj = ActiveWorkbook.Path '取得路径

x1 = 1

For i = 1 To [a65536].End(xlUp).Row

If Cells(i, 1) <> Cells(i + 1, 1) Then

x2 = i

Range(Cells(x1, 1), Cells(x2, 3)).Copy

Workbooks.Add '将复制的内容放入一个新建的工作表

ActiveSheet.Paste

ActiveWorkbook.SaveAs Filename:=Cells(x1, 1), FileFormat:=xlText, CreateBackup:=False

ActiveWindow.Close (True) '关闭文件

x1 = i + 1

End If

Next

End Sub

生成的文本文件会保存在工作簿相同路径下

三、VBA处理单元格数据

用公式解决：

在A1留空，B1输入：

=IF(ISERR(SEARCH( ,$A2,A$1+1))=TRUE,LEN($A2),SEARCH( ,$A2,A$1+1))

在B2输入：

=MID($A2,A$1+1,B$1-A$1)

选中B1:B2向右拉填充。并隐藏第1行。

--------------------------------------------------------

VBA代码解决：

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = 1 And Target.Column = 1 Then

Set Sheet = Sheet1

Sheet.Range(B1:V1).Clear

If Trim(Sheet.Cells(1, 1)) = Then Exit Sub

K = 0

For J = 1 To Len(Trim(Sheet.Cells(1, 1)))

If Mid(Trim(Sheet.Cells(1, 1)), J, 1) = Then

I = I + 1

Sheet.Cells(1, I + 1) = Mid(Trim(Sheet.Cells(1, 1)), K + 1, J - K - 1)

K = J

End If

Next

Sheet.Cells(1, I + 2) = Mid(Trim(Sheet.Cells(1, 1)), K + 1, J - K - 1)

End If

End Sub

四、excel vba 单元格储存的数处理

Sub a()

    Dim rng As Range

    Set rng = Range(a1)

    With Range(b1)

        .NumberFormat = @

        .Value = Mid(rng.Text, 3)

    End With

End Sub报错的原因是数据类型不匹配

五、vba字符串处理

这段程序可以帮你完成，你要的功能，把截取的串给你放在当前sheet中：

Sub Test()

Dim strA As String

Dim i As Integer

strA = 电脑－网络－操作系统－系统故障

i = 1

On Error GoTo Exit_Test

Do

Cells(i, 1) = Mid(strA, 1, InStr(strA, －) - 1)

i = i + 1

strA = Mid(strA, InStr(strA, －) + 1, Len(strA))

Loop While True

Exit_Test:

Cells(i, 1) = strA

End Sub