曹小琴 发表于 2021-12-12 21:53:00

excel部分表格横变竖

需求已经附件中说明。求助大神帮忙。

阿驹 发表于 2022-1-8 20:31:02

先把E列之后转置
再用INDEX+MATCH

梦带我旅行 发表于 2022-1-22 20:47:24

谢谢回复，但我需要的是可能一键生成的方法。 你这个方法应该是先要插入空白行，然后先转置，再用公式吧。步骤有点太复杂了。

素食虎 发表于 2022-1-29 19:12:59

用pq 解决 轻松搞定 vba也简单 都是小事

话事人 发表于 2022-1-31 11:19:11

我也可以给你一个通用些二维转一维的代码 运行后只需按提示操作就行了 秒定

红双 发表于 2022-2-2 08:18:24

Sub 逆透视列()
Dim arr, brr(), n%
Set yssjq = Application.InputBox("请点选:原始数据区域中的任意单元格（包含行标题和列标题）", Type:=8)
arr = yssjq.CurrentRegion
qsl = Val(InputBox("请输入:从第几列开始将列字段转向行方向（以区域为参照物）：", "要开始列传行的起始数字列号", "2"))
bths = Val(InputBox("请输入:列字段表头共有多少行：", "复合表头行数", "1"))
bb = MsgBox("选择： 是 为忽略空值否 为允许空值存在", vbYesNo)
Set jgdyg = Application.InputBox("请点选:存放结果的 起始单元格", Type:=8)
jgdyg.CurrentRegion.Clear
For i = qsl To UBound(arr, 2)
For j = bths + 1 To UBound(arr)
    If bb = 6 Then
      If arr(j, i) <> "" Then
      n = n + 1
      ReDim Preserve brr(1 To qsl + bths, 1 To n + 1)
      For k = 1 To qsl - 1
      If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
      If Len(arr(j, k)) = 0 Then arr(j, k) = brr(k, n)
      brr(k, n + 1) = arr(j, k)
      Next k
      For k = 1 To bths
      If Len(arr(k, i)) = 0 Then arr(k, i) = brr(qsl + k - 1, n)
      If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
      brr(qsl + k - 1, n + 1) = arr(k, i) '循环要转到行的列字段表头
      Next k
      If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
      brr(qsl + bths, n + 1) = arr(j, i)
      End If
    Else
      n = n + 1
      ReDim Preserve brr(1 To qsl + bths, 1 To n + 1)
      For k = 1 To qsl - 1
      If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
      If Len(arr(j, k)) = 0 Then arr(j, k) = brr(k, n)
      brr(k, n + 1) = arr(j, k)
      Next k
      For k = 1 To bths
      If Len(arr(k, i)) = 0 Then arr(k, i) = brr(qsl + k - 1, n)
      If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
      brr(qsl + k - 1, n + 1) = arr(k, i) '循环要转到行的列字段表头
      Next k
      If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
      brr(qsl + bths, n + 1) = arr(j, i)
    End If
Next
Next
For k = 1 To qsl - 1
brr(k, 1) = arr(1, k) '写入转置字段列之前的标题内容
Next k
jgdyg.Resize(UBound(brr, 2), UBound(brr, 1)) = Application.Transpose(brr)
End Sub

洋洋洋洋 发表于 2022-2-6 13:16:50

用pq 只需点3\4下鼠标就瞬间搞定

懒得想名字 发表于 2022-2-11 04:44:55

谢谢大神，按你的方法已经搞定。
页: [1]
查看完整版本: excel部分表格横变竖