我在三列中有一个数据集,其中包括第一列中的一组重复的UUID,第二列中的每个UUID的字符串响应以及第三列中的每个响应的代码。我需要将其分为多组列,每组重复的UUID一组。请参见下图:
我有:
UUID RESPONSE Resp. Code
id1 String1 Code1
id2 String2 Code7
id3 String3 Code3
id1 String4 Code3
id2 String5 Code5
id3 String6 Code1
我需要:
UUID RESPONSE Resp. Code RESPONSE Resp. Code
id1 String1 Code1 String4 Code3
id2 String2 Code7 String5 Code5
id3 String3 Code3 String6 Code1
请注意,虽然此处显示了3个UUID,但实际上我正在处理1377。
我试图为此操作编写一个宏(粘贴在下面),但是我对VBA和Excel宏完全陌生,因此它很hacky,甚至无法关闭我想要的宏。
Sub DestackColumns()
Dim rng As Range
Dim iCell As Integer
Dim lastCol As Integer
Dim iCol As Integer
Set rng = ActiveCell.CurrentRegion
lastCol = rng.Rows(1).Columns.Count
For iCell = 3 To rng.Rows.Count Step 3
Range(Cells(1, iCell), Cells(2, iCell)).Cut
ActiveSheet.Paste Destination:=Cells(lastCol, 1)
Next iCell
End Sub
所有帮助表示赞赏!
这是有些不同的方法。我已经建立了一个名为cUUID的用户定义类。该类具有UUID,Response,ResponseCode和由成对的Response和ResponseCode组成的Collection的属性。
我们创建该类对象的Collection,其中该集合的每个成员都是一个特定的UUID(因为这就是您要对它们进行分组的方式)。
代码遍历数据源,“动态”创建这些对象。然后,我们创建一个包含所有结果的数组,并将该数组写入另一个工作表。
在代码中,如何更改这些工作表名称以及必要时更改源数据和结果的位置应该很明显。
插入类模块后,必须选择它,F4
并将其重命名为cUUID
Option Explicit
Private pUUID As String
Private pResponse As String
Private pRespCode As String
Private pCol As Collection
Public Property Get UUID() As String
UUID = pUUID
End Property
Public Property Let UUID(Value As String)
pUUID = Value
End Property
Public Property Get Response() As String
Response = pResponse
End Property
Public Property Let Response(Value As String)
pResponse = Value
End Property
Public Property Get RespCode() As String
RespCode = pRespCode
End Property
Public Property Let RespCode(Value As String)
pRespCode = Value
End Property
Public Property Get Col() As Collection
Set Col = pCol
End Property
Public Sub Add(Resp1 As String, RC As String)
Dim V(1 To 2) As Variant
V(1) = Resp1
V(2) = RC
Col.Add V
End Sub
Private Sub Class_Initialize()
Set pCol = New Collection
End Sub
Private Sub Class_Terminate()
Set pCol = Nothing
End Sub
Option Explicit
Sub ConsolidateUUIDs()
Dim cU As cUUID, colU As Collection
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes() As Variant
Dim RespPairs As Long
Dim I As Long, J As Long
Set wsSrc = Worksheets("Sheet1")
Set wsRes = Worksheets("Sheet2")
Set rRes = wsRes.Cells(1, 1)
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, "C").End(xlUp))
End With
'Collect the data
Set colU = New Collection
RespPairs = 1
On Error Resume Next
For I = 2 To UBound(vSrc)
Set cU = New cUUID
With cU
.UUID = vSrc(I, 1)
.Response = vSrc(I, 2)
.RespCode = vSrc(I, 3)
.Add .Response, .RespCode
colU.Add cU, CStr(.UUID)
Select Case Err.Number
Case 457
Err.Clear
colU(CStr(.UUID)).Add .Response, .RespCode
J = colU(CStr(.UUID)).Col.Count
RespPairs = IIf(J > RespPairs, J, RespPairs)
Case Is <> 0
Debug.Print Err.Number, Err.Description
Stop
End Select
End With
Next I
On Error GoTo 0
'Sort Collection by UUID
CollectionBubbleSort colU, "UUID"
'Create Results Array
ReDim vRes(0 To colU.Count, 0 To RespPairs * 2)
'header row
vRes(0, 0) = "UUID"
For J = 0 To RespPairs - 1
vRes(0, J * 2 + 1) = "RESPONSE"
vRes(0, J * 2 + 2) = "Resp.Code"
Next J
'Data rows
For I = 1 To colU.Count
With colU(I)
vRes(I, 0) = .UUID
For J = 1 To colU(I).Col.Count
vRes(I, (J - 1) * 2 + 1) = colU(I).Col(J)(1)
vRes(I, (J - 1) * 2 + 2) = colU(I).Col(J)(2)
Next J
End With
Next I
'Write the results array
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2) + 1)
With rRes
.EntireColumn.Clear
.Value = vRes
With .Rows(1)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.EntireColumn.AutoFit
End With
End Sub
'-------------------------------------------------------
'Could use faster sort routine if necessary
Sub CollectionBubbleSort(TempCol As Collection, Optional Prop As String = "")
'Must manually insert element of collection to sort on in this version
Dim I As Long
Dim NoExchanges As Boolean
' Loop until no more "exchanges" are made.
Do
NoExchanges = True
' Loop through each element in the array.
For I = 1 To TempCol.Count - 1
If Prop = "" Then
' If the element is greater than the element
' following it, exchange the two elements.
If TempCol(I) > TempCol(I + 1) Then
NoExchanges = False
TempCol.Add TempCol(I), after:=I + 1
TempCol.Remove I
End If
Else
If CallByName(TempCol(I), Prop, VbGet) > CallByName(TempCol(I + 1), Prop, VbGet) Then
NoExchanges = False
TempCol.Add TempCol(I), after:=I + 1
TempCol.Remove I
End If
End If
Next I
Loop While Not (NoExchanges)
End Sub
UUID将按字母顺序排序。该代码应与不同数量的UUID和对每个UUID的响应数量不同一起使用。
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句