自定义函数--提取单元格内多个被分开的数字

iris00

YZC51 发表于 2019-11-1 13:23
随行列宽高变化的代码

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

请教：为什么我将代码复制过去，运行时提示缺少end sub.这是什么原因呀？

YZC51

iris00 发表于 2019-11-1 15:10
请教：为什么我将代码复制过去，运行时提示缺少end sub.这是什么原因呀？

把附件上传，看看怎么回事

iris00

难道是EXCEL版本问题？

YZC51

iris00 发表于 2019-11-1 15:42
难道是EXCEL版本问题？

如下代码替换Sheet1模块里的代码
Private Sub ToggleButton1_Click()
    Dim JGD As Shape
    If Me.ToggleButton1.Caption = "聚光灯-已关" Then
        ToggleButton1.Caption = "聚光灯-已开"
    Else
        ToggleButton1.Caption = "聚光灯-已关"
        For Each JGD In ActiveSheet.Shapes
            If JGD.Name = "聚光灯-已开" Then JGD.Delete         '删除特定名称的图形
        Next
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     Dim JGD As Shape, lc!, hh!, Col
     If Sheet1.ToggleButton1.Caption = "聚光灯-已开" Then
         n = Target.Row: Col = Target.Column: lc = Target.Width: hg = Target.Height
         nn = Application.Max(n - 100, 1)
         hs = Application.Max(Col - 100, 1)
         On Error Resume Next
         ActiveSheet.Shapes("聚光灯-已开").Delete
         ActiveSheet.Shapes("聚光灯-已开").Delete
        ' For Each JGD In ActiveSheet.Shapes
         '    If JGD.Name = "聚光灯-已开" Then JGD.Delete         '删除特定名称的图形
        'Next
         With ActiveSheet.Shapes.AddShape(msoShapeRectangle, Cells(nn, Col).Left, Cells(nn, Col).Top, lc, hg * 200)
             .Line.Visible = msoFalse                '设置为无轮廓
            .Fill.Visible = msoTrue                 '设置填充（fill）颜色，如果=msofalse，则为无颜色填充
            .Fill.ForeColor.RGB = RGB(247, 17, 238) '设置颜色
            .Fill.Transparency = 0.6                '设置透明度，数字愈大透明度越高
            .Name = "聚光灯-已开"
         End With
         With ActiveSheet.Shapes.AddShape(msoShapeRectangle, Cells(n, hs).Left, Cells(n, 1).Top, lc * 200, hg) 'hh)
             .Line.Visible = msoFalse                '设置为无轮廓
            .Fill.Visible = msoTrue                 '设置填充（fill）颜色，如果=msofalse，则为无颜色填充
            .Fill.ForeColor.RGB = RGB(247, 17, 238) '设置颜色
            .Fill.Transparency = 0.6                '设置透明度，数字愈大透明度越高
            .Name = "聚光灯-已开"
         End With
        
     End If
End Sub

YZC51

代码审核中，直接上传附件
高亮显示.zip (21.17 KB, 下载次数: 25)

2019-11-1 16:07 上传

点击文件名下载附件

sunny_8848

请教，如果想提取第几个数字该怎样写呢。现在是放在一个单元格里面了

YZC51

sunny_8848 发表于 2019-11-1 16:24
请教，如果想提取第几个数字该怎样写呢。现在是放在一个单元格里面了

没有理解您的问题。最好上传附件并且详细说明下

sunny_8848

我要按如图方式提取数字（其中小数点不是分隔符）


新建文件夹.rar (80.67 KB, 下载次数: 11)

2019-11-1 19:19 上传

点击文件名下载附件

YZC51

sunny_8848 发表于 2019-11-1 19:19
我要按如图方式提取数字（其中小数点不是分隔符）

请参考
Function wei(t, x)
    With CreateObject("vbscript.regexp")
        .Pattern = "([1-9][0-9]*)(\.\d+)?"
        .Global = True
            Set mh = .Execute(t)
            str1 = ""
            For Each m In mh
                str1 = str1 & "," & m.Value
            Next
    End With
    num = Split(str1, ",")
    m = UBound(num)
    If x > m Then wei = "" Else wei = num(x)
End Function

YZC51

sunny_8848 发表于 2019-11-1 19:19
我要按如图方式提取数字（其中小数点不是分隔符）

D1=wei($A1,COLUMN(A1))
右拉、下拉