求助，数据格式整理

subay

上传了一份附件，遇到了数据格式整理，源数据是横向排列的，需要改为竖向排列，有没有什么好的办法，好人帮帮忙。

zwzc

=FILTER(TRANSPOSE(C2:N10),TRANSPOSE(C2:N2)<>"")

zwzc

发错帖子了

dambcer

用VBA整                    

subay

dambcer 发表于 2024-12-2 21:31
用VBA整

VBA的思路是什么，遍历单元格么？

subay

zwzc 发表于 2024-12-2 18:30
=FILTER(TRANSPOSE(C2:N10),TRANSPOSE(C2:N2)"")

感谢，感谢，这个有一定的帮助，相比于完全手动提升了不少，但还是很耗时，而且我需要时间也转换成列

sobili

用PQ整理了一份，希望对你有帮助。 求助.rar (32.78 KB, 下载次数: 0)

2024-12-3 04:15 上传

点击文件名下载附件

ykcbf1100

用VBA写一个吧

附件供参考。。。

ykcbf1100

行列转换。。。

1. Sub ykcbf()   '//2024.12.3
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set d1 = CreateObject("Scripting.Dictionary")
   
6.     ReDim brr(1 To 10000, 1 To 100)
   
7.     m = 1: n = 2
   
8.     brr(1, 1) = "时间": brr(1, 2) = "型号"
   
9.     On Error Resume Next
   
10.     With Sheets("原表")
    
11.         c = .UsedRange.Columns.Count
    
12.         arr = .[a1].Resize(10, c)
    
13.     End With
    
14.     For j = 1 To UBound(arr, 2)
    
15.         If InStr(arr(2, j), "指标") Then k = k + 1: d1(k) = j
    
16.     Next
    
17.     For i = 3 To UBound(arr)
    
18.         s = arr(i, 2)
    
19.         If Not d.exists(s) Then
    
20.             n = n + 1
    
21.             d(s) = n
    
22.             brr(1, n) = arr(i, 2)
    
23.         End If
    
24.     Next
    
25.     For k = 1 To d1.Count
    
26.         c1 = d1(k)
    
27.         yf = arr(1, c1 + 2)
    
28.         If k = d1.Count Then c2 = c Else c2 = d1(k + 1) - 1
    
29.         For j = c1 + 2 To c2 Step 2
    
30.             If arr(2, j) <> Empty Then
    
31.                 For i = 3 To UBound(arr)
    
32.                     s = yf & "|" & arr(2, j)
    
33.                     If Not d.exists(s) Then
    
34.                         m = m + 1
    
35.                         d(s) = m
    
36.                         brr(m, 1) = yf
    
37.                         brr(m, 2) = arr(2, j)
    
38.                     End If
    
39.                     r = d(yf & "|" & arr(2, j))
    
40.                     c = d(arr(i, 2))
    
41.                     brr(r, c) = Val(arr(i, j))
    
42.                 Next
    
43.             End If
    
44.         Next
    
45.     Next
    
46.     With Sheets("整理后")
    
47.         .UsedRange.Clear
    
48.         .[a1].Resize(1, n).Interior.Color = 49407
    
49.         With .[a1].Resize(m, n)
    
50.             .Value = brr
    
51.             .Borders.LineStyle = 1
    
52.             .HorizontalAlignment = xlCenter
    
53.             .VerticalAlignment = xlCenter
    
54.             With .Font
    
55.                 .Name = "微软雅黑"
    
56.                 .Size = 11
    
57.             End With
    
58.         End With
    
59.         .[c2].Resize(m - 1, n - 2).HorizontalAlignment = xlRight
    
60.         .[c2].Resize(m - 1, n - 2).NumberFormatLocal = "0.00"
    
61.         .Range("d:d,h:h,j:j").NumberFormatLocal = "0.0%"
    
62.         .Range("c:c,e:g,i:i").NumberFormatLocal = "0"
    
63.         ActiveWindow.DisplayZeros = False
    
64.     End With
    
65.     Application.ScreenUpdating = True
    
66.     MsgBox "OK！"
    
67. End Sub
    

复制代码