VBA如何将同一列的多行数据合并为一行

Wesley123

求助，VBA如何将同一列的多行数据合并为一行？附件Excel表有详细说明和要求。谢谢！

蓝桥玄霜

体育的代码：

一把小刀闯天下

'项目号与项目名称规则不唯一，有一个需要手工确认，，，

Option Explicit

Sub test()
  Dim arr, i, j, p, t, m
  arr = Sheets("运动项目").[a1].CurrentRegion.Offset(1)
  Call bsort(arr, 1, UBound(arr, 1) - 1, 1, UBound(arr, 2), 1)
  For i = 1 To UBound(arr, 1) - 1
    t = t & "、" & arr(i, 3)
    If arr(i, 1) <> arr(i + 1, 1) Or i = UBound(arr, 1) - 1 Then
      m = m + 1
      For j = 1 To 6
        arr(m, j) = arr(i, j)
      Next
      arr(m, 7) = i - p: arr(m, 8) = "?": arr(m, 9) = Mid(t, 2)
      t = vbNullString: p = i
    End If
  Next
  With Sheets("需要的结果").[a2]
    .Resize(UBound(arr, 1), UBound(arr, 2)).ClearContents
    .Resize(m, 9) = arr
  End With
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

Wesley123

蓝桥玄霜 发表于 2020-1-12 10:01
体育的代码：

您好！因为我的数据有几万行，运行时错误“9“：下标越界。调试时这行出现黄色  x = Arr(i, 2) & "|" & Arr(i, 4)，还请指教。您的代码在体育这张表上运行堪称完美。

蓝桥玄霜

Wesley123 发表于 2020-1-12 12:12
您好！因为我的数据有几万行，运行时错误“9“：下标越界。调试时这行出现黄色  x = Arr(i, 2) & "|" & A ...

把Dim语句中的ii%  改为ii&
试试看。

Wesley123

蓝桥玄霜 发表于 2020-1-13 11:09
把Dim语句中的ii%  改为ii&
试试看。

谢谢您！已OK