求助，大神数据提取

桑土公的肚子

请教各位大神，怎么把数据提取成这样

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.27
   
2.     arr = Sheets("Sheet2").UsedRange
   
3.     ReDim brr(1 To 10000, 1 To 6)
   
4.     For i = 1 To UBound(arr)
   
5.         m = m + 1
   
6.         For j = 1 To 6
   
7.             brr(m, j) = arr(i, j)
   
8.         Next
   
9.         For j = 7 To UBound(arr, 2) Step 2
   
10.             If arr(i, j) <> Empty Then
    
11.                 m = m + 1
    
12.                 brr(m, 1) = arr(i, 1)
    
13.                 brr(m, 2) = arr(i, 2)
    
14.                 brr(m, 5) = arr(i, j)
    
15.                 brr(m, 6) = arr(i, j + 1)
    
16.             End If
    
17.         Next
    
18.     Next
    
19.     With Sheets("Sheet3")
    
20.         .UsedRange.Clear
    
21.         With .[a1].Resize(m, 6)
    
22.             .Value = brr
    
23.             .Borders.LineStyle = 1
    
24.             .HorizontalAlignment = xlCenter  '//列居中
    
25.             .VerticalAlignment = xlCenter
    
26.         End With
    
27.     End With
    
28.     MsgBox "OK！"
    
29. End Sub
    

复制代码

LIUZHU

就是一个循环嵌套，总体不难

桑土公的肚子

ykcbf1100  2024-3-27 16:39

лиSelection.NumberFormat = "@"ú

ykcbf1100

桑土公的肚子 发表于 2024-3-28 09:30
лиSelection.NumberFormat = "@"ú

上传附件。
不知道你哪一列是需要文本的，或者你全部都设为文本？

桑土公的肚子

ykcbf1100 发表于 2024-3-28 09:50
上传附件。
不知道你哪一列是需要文本的，或者你全部都设为文本？

感谢大神回复，我找到方法了，全部设置为文本

ykcbf1100

桑土公的肚子 发表于 2024-3-28 10:18
感谢大神回复，我找到方法了，全部设置为文本

那一列设置成文本就可以