转置的问题

tengyt

转置的问题，谢谢老师写写代码

tengyt

朱荣兴 发表于 2018-10-8 18:43
Sub 转置()
Set d = CreateObject("scripting.dictionary")
arr = Sheets("缺勤").[a1].CurrentRegion

谢谢老师，没分了，明天评分，谢谢谢谢

红旗雪

Sub test()
  Dim d, arr, s$, i&
  Set d = CreateObject("scripting.dictionary")
  arr = Sheet1.UsedRange
  For i = 3 To UBound(arr)
    If Not d.exists(arr(i, 5)) Then
      d(arr(i, 5)) = Array(arr(i, 1), arr(i, 5), Format(arr(i, 2), "m/d"))
    Else
      s = d(arr(i, 5))(2) & " " & Format(arr(i, 2), "m/d") & " "
      d(arr(i, 5)) = Array(d(arr(i, 5))(0), d(arr(i, 5))(1), s)
    End If
  Next
  With Sheet2
    .UsedRange.Offset(2).ClearContents
    .Range("a3").Resize(d.Count, 3) = Application.Transpose( _
    Application.Transpose(d.items))
  End With
  Set d = Nothing
End Sub

tengyt

红旗雪 发表于 2018-10-8 19:11
Sub test()
  Dim d, arr, s$, i&
  Set d = CreateObject("scripting.dictionary")

感谢 红旗雪 老师，这代码强大，谢谢老师帮忙，一定评分，谢谢谢谢

tengyt

红旗雪 发表于 2018-10-8 19:11
Sub test()
  Dim d, arr, s$, i&
  Set d = CreateObject("scripting.dictionary")

完美解决问题