批处理之家 - Powered by Discuz! Board

标题: [文本处理] excel把树形分支粘贴到对应数据后面？ [打印本页]

作者: jshuanya 时间: 2024-10-27 20:15 标题: excel把树形分支粘贴到对应数据后面？

表格如下：
A    B       C       D       E          F          G
1                                                    编号       合并
2                                                    708
3                            10                   301
4                                                    709
5                            10                   301
6                                                    709
7                            10                   307
8                            20                   301
9                                                    709
10                            1                   303
11                            12                   400
12                            13                   500
如图所示，D列中是没有序号的是总线，然后下面跟着有序号的分支，分支数量不一定，可能是1，可能有2，3，4，直到下一行出现空行为止，都是其分支。把分支粘贴到对应总线后面，有办法可以解决吗

效果如下：
         F    G
      编号合并
      708 301
      709 301
      709 307  301
      709 303 400  500

作者: idwma 时间: 2024-10-28 13:11

#@&cls&powershell "type '%~0'|out-string|iex"&pause&exit
$fn='aaaaaa.xlsx'
$a=new-object -com excel.application
$a.visible=1
$b=$a.workbooks.open("$(dir $fn)")
$c=$b.sheets.item(1)
$d=$c.usedrange.cells.value()
$i=$d.length/7
2..$i|%{
 if($f){
  if($d[$_,4]){
   $d[$_,7]+=[string]$d[$_,6]+' '
   $d[$_,6]=''
  }else{
   $f+=1
   $d[$f,6]=$d[$_,6]
   $d[$_,6]=''
  }
 }else{
  $f=$_
 }
}
$c.usedrange.cells.value()=$d
复制代码

作者: Five66 时间: 2024-10-28 14:56

vba ,打开文档 ,创建一个宏 ,删掉新建后原来的 ,然后复制下面的后执行 ,最后关掉窗口返回excel删掉宏

Sub kk()
Dim aa As Worksheet, bb As Range, cc As Long
Set aa = Sheets.Item(1)
Set bb = aa.Range("A:A")
cc = bb.Count
dd = 0
ee = ""
zz = 2

For i = 2 To cc
ff = aa.Cells(i, 4).Value2

If dd = 2 Then
If IsEmpty(ff) Then
dd = 1
aa.Cells(zz, 7).NumberFormat = "@"
aa.Cells(zz, 7).Value2 = ee
ee = ""
zz = i
Else
ee = ee & "  " & aa.Cells(i, 6).Value2
End If
ElseIf dd = 1 Then
If IsEmpty(ff) Then
zz = i
Exit For
Else
ee = ee & "  " & aa.Cells(i, 6).Value2
dd = 2
End If
ElseIf dd = 0 Then
If IsEmpty(ff) Then
dd = 1
zz = i
Else
zz = zz
End If
End If

Next i

If Not zz = 2 Then
For i = zz To 2 Step -1
If IsEmpty(aa.Cells(i, 7).Value2) Then
aa.Rows(i).Delete
End If
Next i
End If

MsgBox "done!!!"
End Sub
复制代码

作者: czjt1234 时间: 2024-10-28 16:02

回复 2# idwma

请问这个第9行是什么语法？怎么以2开头的？

作者: idwma 时间: 2024-10-28 17:13

回复 4# czjt1234

https://learn.microsoft.com/zh-cn/powershell/module/microsoft.powershell.core/about/about_operators?view=powershell-5.1#range-operator-
从第2行开始到最后一行
2..$i|%{}相当于for($i=2; $i -le 12; $i++){}

作者: aloha20200628 时间: 2024-10-28 20:00

本帖最后由 aloha20200628 于 2024-10-28 20:03 编辑

回复 1# jshuanya

假设一楼示例的 *.xls* 文件存为 1.csv 如下：

1,,,,,编号,合并
2,,,,,708,
3,,,10,,301,
4,,,,,709,
5,,,10,,301,
6,,,,,709,
7,,,10,,307,
8,,,20,,301,
9,,,,,709,
10,,,1,,303,
11,,,12,,400,
12,,,13,,500,
复制代码

用以下批处代码（存为 test.bat 运行，与 1.csv 文件同目录）可获取一楼示例的结果文件 2.csv 如下：

1,,,,,编号,合并
2,,,,,708, 301
4,,,,,709, 301
6,,,,,709, 307 301
9,,,,,709, 303 400 500
复制代码

@echo off &setlocal enabledelayedexpansion
echo,1,,,,,编号,合并>2.csv
(for /f "skip=1 delims=" %%A in (1.csv) do (
    set "a=%%A" &for /l %%n in (1,1,2) do set "a=!a:,,=,#,!"
    for /f "tokens=1-6 delims=," %%a in ("!a!") do (
    if "%%d"=="#" ((if defined s echo,!s!)&set "s=%%A") else (set "s=!s! %%f")
))
if defined s echo,!s!)>>2.csv
endlocal&pause&exit/b
复制代码

作者: jshuanya 时间: 2024-10-31 19:33

回复 6# aloha20200628

谢谢。

作者: jshuanya 时间: 2024-10-31 19:37

本帖最后由 jshuanya 于 2024-10-31 19:57 编辑

回复 3# Five66

谢谢，可以用，如果需要实现以上的同时拷贝分支所在行M列的数据也放进去，用逗号连接，分支所在行M列数据结尾用分号，有办法吗。

附件如下：
链接: https://pan.baidu.com/s/1TP5bofdhZxBcEWo9FUrUSg?pwd=85s3 提取码: 85s3 复制这段内容后打开百度网盘手机App，操作更方便哦

作者: Five66 时间: 2024-11-1 16:41

回复 8# jshuanya

试试下面的

Sub kk()
Dim aa As Worksheet, bb As Range, cc As Long
Set aa = Sheets.Item(1)
Set bb = aa.Range("A:A")
cc = bb.Count
dd = 0
ee = ""
zz = 2

For i = 2 To cc
ff = aa.Cells(i, 4).Value2

If dd = 2 Then
If IsEmpty(ff) Then
dd = 1
aa.Cells(zz, 7).NumberFormat = "@"
aa.Cells(zz, 7).Value2 = ee
ee = ""
zz = i
Else
ee = ee & ";" & aa.Cells(i, 6).Value2 & "," & aa.Cells(i, 13).Text
End If
ElseIf dd = 1 Then
If IsEmpty(ff) Then
zz = i
Exit For
Else
ee = ee & aa.Cells(i, 6).Value2 & "," & aa.Cells(i, 13).Text
dd = 2
End If
ElseIf dd = 0 Then
If IsEmpty(ff) Then
dd = 1
zz = i
Else
zz = zz
End If
End If

Next i

zz = zz - 2
If zz > 2 Then
For i = zz To 2 Step -1
If Not IsEmpty(aa.Cells(i, 4).Value2) Then
aa.Rows(i).Delete
End If
Next i
End If

MsgBox "done!!!"
End Sub
复制代码

欢迎光临批处理之家 (http://bbs.bathome.net/)