发布时间:2023-12-27 20:53来源:www.sf1369.com作者:宇宇
代码如下,详见附件。
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
用下面代码试试吧
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
生成的文本文件会保存在工作簿相同路径下
用公式解决:
在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
Sub a()
Dim rng As Range
Set rng = Range(a1)
With Range(b1)
.NumberFormat = @
.Value = Mid(rng.Text, 3)
End With
End Sub报错的原因是数据类型不匹配
这段程序可以帮你完成,你要的功能,把截取的串给你放在当前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