求个数据分类转置

czr0373

源数据
分类转置后：

ddyddy

试着写了代码如下，见笑了
Sub nu()
    Dim rng As Range
    Dim arr1() As String, arr2() As String
    Dim i&, j&
    For Each rng In Range("a3:a" & [a3].End(xlDown).Row)
        If IsNumeric(Mid(rng.Value, 4, 1)) Then
            i = i + 1
            ReDim Preserve arr1(1 To i)
            arr1(i) = rng.Value
        Else
            j = j + 1
            ReDim Preserve arr2(1 To j)
            arr2(j) = rng.Value
        End If
    Next
    Range("b3").Resize(1, UBound(arr1)) = arr1
    Range("b4").Resize(1, UBound(arr2)) = arr2
End Sub

一把小刀闯天下

'示例数据少了点，凑了一个，，，

Option Explicit

Sub test()
  Dim arr, i, j, t, p, m, n, max
  arr = Range("a3:c" & [a3].End(xlDown).Row + 1).Value
  ReDim brr(1 To UBound(arr, 1) / 2, 1 To 20)
  For i = 1 To UBound(arr, 1) - 1
    t = Split(arr(i, 1), ".")(0)
    For j = Len(t) To 1 Step -1
      If Not IsNumeric(Mid(t, j, 1)) Then
        arr(i, 2) = left(t, j): arr(i, 3) = Mid(t, j + 1)
        Exit For
      End If
    Next
    If j = 0 Then arr(i, 2) = vbNullString: arr(i, 3) = arr(i, 2)
  Next
  Call bsort(arr, 1, UBound(arr, 1) - 1, 1, 3, 2)
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 2) <> arr(i + 1, 2) Then
      Call bsort(arr, p + 1, i, 1, 3, 3)
      m = m + 1: n = 0
      For j = p + 1 To i
        n = n + 1
        brr(m, n) = arr(j, 1)
      Next
      If max < n Then max = n
      p = i
    End If
  Next
  [b3].Resize(m, max) = brr
End Sub

Function bsort(arr, first, last, left, right, key)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If arr(j, key) > arr(j + 1, key) Then
        For k = left To right
          t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
        Next
      End If
    Next
  Next
End Function

czr0373

一把小刀闯天下 发表于 2021-1-16 18:02
'示例数据少了点，凑了一个，，，

Option Explicit

请教老师，分类转换时如何不区分字母的大小写

opel-wong

czr0373 发表于 2021-1-16 18:41
请教老师，分类转换时如何不区分字母的大小写

Ucase转换成大写判断，

czr0373

一把小刀闯天下 发表于 2021-1-16 18:02
'示例数据少了点，凑了一个，，，

Option Explicit

搜了一个，顶端Option Compare Text

zpy2

with a as (select regexp2('([^\d]+)\d\.',分类转置,1) 类,* from 分类转置明细表) select group_concat(分类转置) from a group by 类