[已解决]怎么将选中的项目名称提取到特定的单元格

hhxq001

想将工资表中选中的项目名称提取到分类表的d3、e3中，没有成功，请高手帮帮忙看看怎么才能达到效果呢

提取字段 -间隔0321.zip (295.27 KB, 下载次数: 5)

2021-3-21 16:32 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

高

2021-3-21 22:38

请试验

跳转到最佳答案楼层

高

请试验

hhxq001

高 发表于 2021-3-21 22:38
请试验

太太强大了，请教这句是什么意思

arr = Split(xzxm.Address, ",")

高

hhxq001 发表于 2021-3-22 08:46
太太强大了，请教这句是什么意思

arr = Split(xzxm.Address, ",")

xzxm.Address就是xzxm的单元格地址。 Split是vba的拆分函数，利用 Split把xzxm的单元格地址按英文的逗号拆分。拆分结果写入数组arr

hhxq001

高 发表于 2021-3-22 12:04
xzxm.Address就是xzxm的单元格地址。 Split是vba的拆分函数，利用 Split把xzxm的单元格地址按英文的逗号 ...

很有意思的一段代码。按住ctrl+鼠标单击选择是很好的（比如$F$3,$G$3），但如果直接鼠标拖选中（$E$3:$F$3），就无效了，又改怎么修改呢？就是不管怎么选中，都可以。

hhxq001

高 发表于 2021-3-22 12:04
xzxm.Address就是xzxm的单元格地址。 Split是vba的拆分函数，利用 Split把xzxm的单元格地址按英文的逗号 ...

麻烦再给看看5楼的问题怎么解决哦

高

arr = Split(xzxm.Address, ",")是按英文的逗号拆分的。如果直接鼠标拖选中（$E$3:$F$3）再运行此代码，结果还是$E$3:$F$3。如果你要这么选，就要改一下代码，加判断了。arr = Split(xzxm.Address, ",")换成：

If InStr(xzxm.Address, ",") Thenarr = Split(xzxm.Address, ",")
Else
arr= Split(xzxm.Address, ":")
End If

242507720

Sub 选择表格的时候注意选择的先后顺序()
  Dim rng As Range, rg As Range, n%
  Sheet9.Range("d3", "f3").ClearContents
    On Error Resume Next
    Set rng = Application.InputBox(Prompt:="请选择单元格", Type:=8)
    If rng Is Nothing Then Exit Sub
    For Each rg In rng
        n = n + 1
        If n > 2 Then
            Exit For
        Else
            If n = 1 Then Sheet9.[d3] = Cells(3, rg.Column).Value
            If n = 2 Then Sheet9.[f3] = Cells(3, rg.Column).Value
        End If
    Next
    Sheet9.Select
End Sub复制到模块中直接用就好了。

hhxq001

在“高”坛友的帮助下，终于可以完美提取项目字段使用了，再次感谢。
Sub 选择项目()
Dim xzxm As Range, cc%, dd%
  On Error Resume Next
Set xzxm = Application.InputBox("请点选补助项目,可以按住Ctrl+鼠标左键选2项", "提示：最多选择2项，多选无效", , , , , , 8)  'Default:="$E$3",
  If xzxm Is Nothing Then Exit Sub
If xzxm.Count >= 2 Then '如果项目的个数大于，最多2个有效

If InStr(xzxm.Address, ",") Then arr = Split(xzxm.Address, ",")
If InStr(xzxm.Address, ":") Then arr = Split(xzxm.Address, ":")

cc = 1
dd = 2

With Sheet9
.[d3] = Sheet7.Range(arr(cc - 1)).Value
.[f3] = Sheet7.Range(arr(dd - 1)).Value
End With

Else

With Sheet9
.[d3] = Sheet7.Cells(3, xzxm.Column) '如果只选择了一个项目，则d3赋值，f3保留空白
.[f3] = ""
End With

End If
Sheet9.Select
End Sub

hhxq001

242507720 发表于 2021-3-23 21:49
Sub 选择表格的时候注意选择的先后顺序()
  Dim rng As Range, rg As Range, n%
  Sheet9.Range("d3", "f ...

厉害，又一种方法，能解释一下过程吗