用VBA代码，将表格所有单元格中分多行的数据转换为一行

lhteee

示例.rar (7.75 KB, 下载次数: 13)

2024-8-14 16:56 上传

点击文件名下载附件

taller

小凡、、、

lhteee

taller 发表于 2024-8-14 17:02

给个完整的代码吧！谢谢

饮冰e士

1. Option Explicit
   
2. 
   
3. Sub Macro1()
   
4. '
   
5. ' Macro1 Macro
   
6. ' 宏由 饮冰e士 录制，时间: 2024/08/14
   
7. '
   
8. 
   
9. '
   
10.   'Columns("B:B").Select
    
11.   ActiveSheet.UsedRange.Select
    
12.   Selection.Replace What:="" & Chr(10) & "", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, MatchByte:=False, SearchFormat:=True, ReplaceFormat:=True
    
13. End Sub
    

复制代码

quqiyuan

ykcbf1100

参与一下，数组法。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.14
   
2.     arr = Sheets("Sheet1").UsedRange
   
3.     ReDim brr(1 To UBound(arr), 1 To 4)
   
4.     For i = 1 To UBound(arr)
   
5.         m = m + 1
   
6.         For j = 1 To 4
   
7.             brr(m, j) = arr(i, j)
   
8.         Next
   
9.         brr(m, 2) = Join(Split(arr(i, 2), Chr(10)), "")
   
10.         brr(m, 4) = Join(Split(arr(i, 4), Chr(10)), "")
    
11.     Next
    
12.     With Sheets("Sheet2")
    
13.         .UsedRange.ClearContents
    
14.         .[a1].Resize(m, 4) = brr
    
15.         .[a1].Resize(m, 4).Borders.LineStyle = 1
    
16.     End With
    
17.     MsgBox "OK！"
    
18. End Sub
    

复制代码

lhteee

饮冰e士 发表于 2024-8-14 18:02

谢谢，用这个了！

lhteee

谢谢各位了！！！