将分支电缆导入到电缆标牌表中

◆华佗◆ · 发表于 2024-9-9 11:50

将分支电缆导入到电缆标牌表中，具体规律见图和附件。

limonet · 发表于 2024-9-9 14:15

Sub limonet()
Dim i%, j%, k%, Arr As Variant, Cn As Object, StrSQL$
Set Cn = CreateObject("Adodb.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
StrSQL = "Select [电缆编号]&' '&[起点]&' '&[终点]&' '&[电缆规格] From [分支电缆$B2:E]"
Arr = Cn.Execute(StrSQL).getrows
For i = 2 To UBound(Arr, 2) + 3 Step 5
      For j = 2 To 11 Step 3
         Range("M2:N5").Copy Cells(i, j - 1)
         Cells(i, j).Resize(4) = Application.Transpose(Split(Arr(0, k)))
         k = k + 1
      Next j
Next i
End Sub

limonet · 发表于 2024-9-9 14:18

关键字：苦力活。

◆华佗◆ · 发表于 2024-9-9 14:36

limonet 发表于 2024-9-9 14:18
关键字：苦力活。

谢谢，结果有出入，您再看一下

limonet · 发表于 2024-9-9 14:37

Sub limonet()
Dim i%, j%, k%, Arr As Variant, Cn As Object, StrSQL$
Set Cn = CreateObject("Adodb.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;imex=1';Data Source=" & ThisWorkbook.FullName
StrSQL = "Select [电缆编号]&'￥'&[起点]&'￥'&[终点]&'￥'&[电缆规格] From [分支电缆$B2:E]"
Arr = Cn.Execute(StrSQL).getrows
For i = 2 To UBound(Arr, 2) + 30 Step 5
      For j = 2 To 11 Step 3
         Range("M2:N5").Copy Cells(i, j - 1)
         Cells(i, j).Resize(4) = Application.Transpose(Split(Arr(0, k), "￥"))
         k = k + 1
      Next j
Next i
End Sub

limonet · 发表于 2024-9-9 14:39

因数据格式各异。

◆华佗◆ · 发表于 2024-9-9 14:44

limonet 发表于 2024-9-9 14:39
因数据格式各异。

谢谢，完全正确

鄂龙蒙 · 发表于 2024-9-9 15:20

填充.rar (759.26 KB, 下载次数: 19)

◆华佗◆ · 发表于 2024-9-9 16:41

鄂龙蒙发表于 2024-9-9 15:20

谢谢，能用

◆华佗◆ · 发表于 2024-9-9 20:15

本帖最后由 ◆华佗◆ 于 2024-9-9 20:16 编辑

limonet 发表于 2024-9-9 14:39
因数据格式各异。

您好，试了几次，发现加了数据后，有数据丢失

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

[求助] 将分支电缆导入到电缆标牌表中

评分