各位大佬 谁有行转列的工具

wunai3114

各位大佬

急需要1个批量行转列的工具，需要操作几十万行，转换后可能超出100列

x-xx-xx

1-2              

ykcbf1100

数据结构差不多，供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.2.15
   
2.     Dim arr, brr, d
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     arr = [a1].CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         s = arr(i, 1): ss = arr(i, 2)
   
7.         If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
   
8.         d(s)(ss) = arr(i, 2)
   
9.     Next
   
10.     ReDim brr(1 To d.Count, 1 To 1000)
    
11.     For Each k In d.keys
    
12.         m = m + 1: n = 1
    
13.         brr(m, 1) = k
    
14.         For Each kk In d(k).keys
    
15.             n = n + 1
    
16.             brr(m, n) = d(k)(kk)
    
17.         Next
    
18.         Max = IIf(Max > n, Max, n)
    
19.     Next
    
20.     ActiveSheet.UsedRange.Offset(1, 4) = ""
    
21.     [e2].Resize(m, Max) = brr
    
22.     [e2].Resize(m, Max).EntireColumn.AutoFit
    
23.     MsgBox "OK！"
    
24. End Sub
    

复制代码

gwjkkkkk

请参考 。。。

wunai3114

gwjkkkkk 发表于 2024-2-15 12:59
请参考 。。。

大佬，能发个工具不

gwjkkkkk

wunai3114 发表于 2024-2-15 13:14
大佬，能发个工具不

你没有附件，我就顺手写了一下，代码没保存，代码敲一遍应该也快。。。

fzxba

1. Sub test0() '假设A列有序
   
2.   Dim ar, br(1 To 90000, 1 To 150) '据情况调整
   
3.   Dim i As Long, j As Long, r As Long, c As Long, s As String
   
4.   r = 1
   
5.   br(r, 1) = "输出"
   
6.   For j = 2 To UBound(br, 2)
   
7.     br(r, j) = "列" & j - 1
   
8.   Next
   
9.   ar = Range("A1").CurrentRegion.Offset(1).Resize(, 2).Value
   
10.   For i = 1 To UBound(ar) - 1
    
11.     If s <> ar(i, 1) Then
    
12.       s = ar(i, 1)
    
13.       r = r + 1
    
14.       For j = 1 To 2
    
15.         br(r, j) = ar(i, j)
    
16.       Next
    
17.     Else
    
18.       br(r, j) = ar(i, 2)
    
19.       j = j + 1
    
20.     End If
    
21.     If ar(i, 1) <> ar(i + 1, 1) Then If j > c Then c = j
    
22.   Next
    
23.   With Range("D1")
    
24.     .CurrentRegion.ClearContents
    
25.     .Resize(r, c - 1) = br
    
26.   End With
    
27. End Sub

复制代码

micch

这种属于很常见的功能，不过单独做成工具的少吧，应该很多插件里会带这个功能