感谢楼主的分享
谢谢，已收藏
(defun StrType(a / b c d e);;字符串分离全角、符号、字母、数字,存在问题：连续小数点与数字相连不能精确分离数字和小数点
(setq b(vl-string->list a))
(while b
(setq a(car b)b(cdr b)c(last d))
(if(or(not d)
(and(< 0 a 32)(< 0 c 32));;非打印字符
(or(= 46 a)(= 46 c)(and(< 47 a 58)(< 47 c 58)));数字和小数点
(vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((31 48)(57 65)(90 98)(122 129))))(list a c));其它字符包括小数点
(vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((64 91)(96 123))))(list a c));;字母
(and(> a 128)(> c 128)));;全角字符
(if(> a 128)(setq d(vl-list*(car b)a d)b(cdr b))(setq d(cons a d)))
(setq e(cons(reverse d)e)d(if(> a 128)(list(car b)a)(List a))b(if(> a 128)(cdr b)b))))
(mapcar'vl-list->string(reverse(cons(reverse d)e))))
感谢大神分享
收藏广州SCS数据转南方CASSDATEXCEL VBA
Sub 转换()
Dim numcol As Integer
Dim numrow As Long
Dim i As Long
Dim x As Integer
Dim numperrow As Integer
numperrow = InputBox("请输入每行要填的数据行的数目:")
Dim myRange As Range
Set myRange = Application.InputBox("选择区域", Type:=8)
myRange.Name = "数据"
Range("数据").Select
numrow = Selection.Rows.Count '数据区的行数
numcol = Selection.Columns.Count '数据区的列数
x = numperrow * numcol
Range("a1").Select
For i = 1 To numrow '以数据的每一行为单位进行剪切
Range("数据").Rows(i).Cut
ActiveSheet.Paste
Selection.Offset(, numcol).Select
If (i Mod numperrow) Then '判断是否要换行
Else: Selection.Offset(1, -x).Select
End If
Next i
End Sub
本帖最后由 树櫴希德 于 2022-6-17 11:32 编辑
(defun chains(es fuz / e a b s pts);;链式选择，选择首尾相连的线
(setq s(ssadd))
(while es
(setq e(car es)es(cdr es)
p1(mapcar'+'(0 0)(vlax-curve-getStartPoint e))p2(mapcar'+'(0 0)(vlax-curve-getendPoint e)))
(foreach a(S2E(ssget"CP"(list p1(list(car p1)(cadr p2))p2(list(car p2)(cadr p1)))'((0 . "arc,*spline,*polyline,line"))))
(or(SSMEMB a s)
((lambda()
(setq p1(mapcar'+'(0 0)(vlax-curve-getStartPoint a))
p2(mapcar'+'(0 0)(vlax-curve-getendPoint a)))
(and(vl-some'(lambda(x)(or(equal p1 x fuz)(equal p2 x fuz)))pt)
(setq es(cons a es)pt(vl-list* p1 p2 pt))
(ssadd a s)))))))
(sssetfirst'nil s)
)
(defun chains(es fuz / e a b s pts)
(setq s(ssadd))
(while es
(setq e(car es)es(cdr es)
p1(mapcar'+'(0 0)(vlax-curve-getStartPoint e))p2(mapcar'+'(0 0)(vlax-curve-getendPoint e)))
(foreach a(S2E(ssget"CP"(list p1(list(car p1)(cadr p2))p2(list(car p2)(cadr p1)))'((0 . "arc,*spline,*polyline,line"))))
(or(SSMEMB a s)
((lambda()
(setq p1(mapcar'+'(0 0)(vlax-curve-getStartPoint a))
p2(mapcar'+'(0 0)(vlax-curve-getendPoint a)))
(and(vl-some'(lambda(x)(or(equal p1 x fuz)(equal p2 x fuz)))pt)
(setq es(cons a es)pt(vl-list* p1 p2 pt))
(ssadd a s)))))))
(sssetfirst'nil s))
树櫴希德 发表于 2022-6-14 22:58
收藏广州SCS数据转南方CASSDATEXCEL VBA
Public Sub 表格加1()
Dim myRange As Range
Set myRange = Application.InputBox("选择区域", Type:=8)
For Each x In myRange
x.Formula = x + 1
Next x
End Sub
树櫴希德 发表于 2022-6-18 17:31
EXCEL 表格根据内容转置但是效果不好
Public Sub mm()
Dim numcol As Integer
Dim numrow As Long
'Dim mypos As Integer
Dim i As Long
Dim myRange As Range
Set myRange = Application.InputBox("选择区域", Type:=8)
myRange.Name = "数据"
Range("数据").Select
numrow = Selection.Rows.Count '数据区的行数
numcol = Selection.Columns.Count '数据区的列数
Range("a1").Select
For Each Rng In myRange
Rng.Cut
ActiveSheet.Paste
Selection.Offset(, numcol).Select
If (InStr(Rng, "begin") = 0) Then '判断是否要换行 Cells(Rng + 1, 0).Select
Else: Selection.Offset(1, -1 * Rng.Column).Select
End If
Next Rng
End Sub
VBA？ 发贴楼主应该把自己的经典或者优化别人的分享出来。
发帖用别人的可不太好！