如图，14-17列怎么也能自动连线，有思路就送花

准提部林 · 发表于 2023-2-18 12:55

zhlinger2030 发表于 2023-2-18 12:44
大神，麻烦看看，为啥放到原表格中就不行了，是那出问题了

改兩行//

For Each Z In [F37,W37,AA37]

Set A = xR.Find("?*")

zhlinger2030 · 发表于 2023-2-18 14:46

准提部林发表于 2023-2-18 12:55
改兩行//

For Each Z In [F37,W37,AA37]

改了，出来怎么是这样呢

大神帮忙看看
无标题2.png

zhlinger2030 · 发表于 2023-2-18 14:48

zhlinger2030 发表于 2023-2-17 22:02
好的，谢大佬

可以了，但是放到原表格中，怎么不显示，麻烦大佬看看啥问题

测试1.rar (34.37 KB, 下载次数: 1)

准提部林 · 发表于 2023-2-18 19:13

zhlinger2030 发表于 2023-2-18 14:48
可以了，但是放到原表格中，怎么不显示，麻烦大佬看看啥问题

Set A = xR.Find("?*", LookIn:=xlValues)
單元格是公式//尋找"值"

TEST11.rar (21.5 KB, 下载次数: 15)

zhlinger2030 · 发表于 2023-2-18 19:52

准提部林发表于 2023-2-18 19:13
Set A = xR.Find("?*", LookIn:=xlValues)
單元格是公式//尋找"值"

大佬，万分感谢，
今日没花了，明日一定补上

zhlinger2030 · 发表于 2023-2-18 20:35

准提部林发表于 2023-2-18 19:13
Set A = xR.Find("?*", LookIn:=xlValues)
單元格是公式//尋找"值"

大佬，又来烦你了，这什么情况

无标题0000.png

TEST00.rar (75.81 KB, 下载次数: 1)

准提部林 · 发表于 2023-2-18 20:55

zhlinger2030 发表于 2023-2-18 20:35
大佬，又来烦你了，这什么情况

CurrentRegion會將連續非空湊在一塊//
第1及35行不要合併//
最好在序號上方保持空白

TEST00-1.rar (18.59 KB, 下载次数: 17)

zhlinger2030 · 发表于 2023-2-18 21:29

准提部林发表于 2023-2-18 20:55
CurrentRegion會將連續非空湊在一塊//
第1及35行不要合併//
最好在序號上方保持空白

原来是这样啊，学习了

剑指E · 发表于 2023-2-18 22:06

本帖最后由剑指E 于 2023-2-19 00:24 编辑

Sub lx()
Dim rgs As Range, c As Range, ar, i&, br
br = Array("a2:l", "n2:u")
With Sheet1
For j = 0 To UBound(br)
Set rgs = Intersect(.UsedRange, .Range(br(j) & Rows.Count))
ReDim ar(1 To rgs.Rows.Count, 1 To 2)
For Each c In rgs
If c <> "" Then
i = i + 1
ar(i, 2) = c.Top + c.Height / 2
ar(i, 1) = c.Left + c.Width / 2
End If
Next
For i = 1 To UBound(ar) - 1
If ar(i + 1, 1) <> "" Then .Shapes.AddConnector(1, ar(i, 1), ar(i, 2), ar(i + 1, 1), ar(i + 1, 2)).Select Else Exit For
Next
i = 0
Next
End With
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 如图，14-17列怎么也能自动连线，有思路就送花