这种转置VBA能完成吗?敬请老师出手相助,谢谢!

WANT-T

wtb8152 发表于 2023-4-18 17:26
WANT-T老师好!
横向打印有考虑过,就是页码插入时与前面页的页码位置不一致.
我是双面打印的,必须奇偶页 ...

页码好解决，哪怕套打一下也比转置容易，方便

全党

数据给你换过来了，自己加上单元格格式就好了。

Sub shishi()
Dim brr()
arr = Sheets("sheet1").UsedRange
rn = UBound(arr)
cn = UBound(arr, 2)
ReDim Preserve brr(1 To cn, 1 To rn)
For i = 1 To rn
     i1 = i1 + 1
     For j = cn To 1 Step -1
     j1 = j1 + 1
       brr(j1, i1) = arr(i, j)
     Next j
     j1 = 0
Next i
Sheets("sheet3").[a10].Resize(cn, rn) = brr
End Sub

鱼划水

Sub test()
Dim Arr As Variant
Arr = Sheet1.UsedRange
Sheet2.Cells(1, 1).Resize(UBound(Arr, 2), UBound(Arr, 1)) = Application.Transpose(Arr)
End Sub

全党

醒得早，给你弄了一下，试试吧

yynrzwh

参与一下

1. Sub 宏1()
   
2. arr = Sheet1.UsedRange
   
3. ReDim brr(1 To UBound(arr, 2), 1 To UBound(arr))
   
4.     For i = UBound(arr, 2) To 1 Step -1
   
5.         k = k + 1
   
6.         For j = 1 To UBound(arr)
   
7.             brr(i, j) = arr(j, k)
   
8.         Next
   
9.     Next
   
10. 
    
11.     With Sheet3.Range("A1").Resize(UBound(brr), UBound(brr, 2))
    
12.         .Value = brr
    
13.         Sheet3.Range("A10").Value = arr(1, 1)
    
14.         Sheet3.Range("B1").Value = arr(2, 1)
    
15.         .Orientation = 90
    
16.     End With
    
17. End Sub
    

复制代码

wtb8152

本以为已无望了，没想到这么多的热心老师还是给做出来了。鄙人统一在这表示深深的感谢！

wtb8152

hansome221 发表于 2023-4-18 17:41

谢谢hansome221老师热心相助!

wtb8152

全党 发表于 2023-4-18 19:21
数据给你换过来了，自己加上单元格格式就好了。

Sub shishi()

谢谢全党老师热心相助!

wtb8152

yynrzwh 发表于 2023-4-19 09:14
参与一下

谢谢yynrzwh老师热心相助!

wtb8152

鱼划水 发表于 2023-4-18 22:21
Sub test()
Dim Arr As Variant
Arr = Sheet1.UsedRange

谢谢鱼划水老师热心相助!