Excel VBA: 将信息强制转换为逗号分隔的字符串

Question

我有两个 excel 工作表（“Sheet1”和“Sheet2”）。 Sheet2 包含我想根据 ID 分组并呈现在“Sheet1”中的原始数据。也就是说，我想根据 ID 强制 'FEED' 和 'NUMB'，并将 'FEED' 和 'NUMB' 存储为逗号分隔的字符串（参见下面的示例数据）。

此过程需要是动态的，即如果我在 Sheet2 中输入新数据，Sheet1 中显示的信息会自动更新。

请注意，我想使用 VBA 来执行此操作，我是一个绝对的初学者（Microsoft Excel 2019 和 非英语 ).我一直在尝试使用 VBA 反向执行此操作（即将根据 Sheet1 存储的数据拆分为 Sheet2），但是我在试验中一直没有成功。我通常不喜欢在 Excel 工作，尽管目前的情况迫使我不得不这样做

Sheet2

| Group | ID    | FEED  | NUMB |
|:-----:|:-----:|:-----:|:----:|
| B     | B1    | C1    | 1    |
| B     | B2    | L3    | 43   |
| B     | B3    | K12   | 101  |
| B     | B1    | G1    | 86   |
| B     | B3    | H2    | 109  |
| C     | C1    | L3    | 23   |
| C     | C2    | G1    | 24   |
| C     | C1    | L4    | 54   |
| C     | C1    | K8    | 56   |

Sheet1

| Group | ID | FEED     | NUMB     |
|:-----:|:--:|:--------:|:--------:|
| B     | B1 | C1,G1    | 1,86     |
| B     | B2 | L3       | 43       |
| B     | B3 | K12,H2   | 101,109  |
| C     | C1 | L3,L4,K8 | 23,54,56 |
| C     | C2 | G1       | 24       |

Answer 1

请尝试下一个代码。它 return 从“O1”开始。它可以 return 您需要的任何地方：

Sub TestProcessCommaSep()
 'It needs a reference to 'Microsoft Scripting Runtime'
 Dim sh As Worksheet, lastR As Long, arr, arrFin, arrInt
 Dim dict As New Scripting.Dictionary, i As Long, k As Long
 
 Set sh = ActiveSheet 'use here the sheet you need
 lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
 
 arr = sh.Range("A2:D" & lastR).value   'put the range to be processed in an array
 ReDim arrFin(1 To 4, 1 To UBound(arr)) 'redim the final array to make space for maximum
 
 For i = 1 To UBound(arr) 'iterate between arr elements
    If Not dict.Exists(arr(i, 1) & "|" & arr(i, 2)) Then 'if the key does not exist:
        dict.Add arr(i, 1) & "|" & arr(i, 2), arr(i, 3) & "|" & arr(i, 4) 'it is created
    Else
        'add to the existing key the values in columns 3 and 4:
        arrInt = Split(dict((arr(i, 1) & "|" & arr(i, 2))), "|")
        dict(arr(i, 1) & "|" & arr(i, 2)) = arrInt(0) & "," & arr(i, 3) & "|" & arrInt(1) & "," & arr(i, 4)
    End If
 Next i
 'fill the final array:
 For i = 0 To dict.count - 1
    k = k + 1
    arrFin(1, k) = Split(dict.Keys(i), "|")(0)
    arrFin(2, k) = Split(dict.Keys(i), "|")(1)
    arrFin(3, k) = Split(dict.items(i), "|")(0)
    arrFin(4, k) = Split(dict.items(i), "|")(1)
 Next
 ReDim Preserve arrFin(1 To 4, 1 To k) 'keep only the elements keeping values
 'Put the header, dropping the array elements at once:
 With sh.Range("O1")
    .Resize(1, 4).value = sh.Range("A1:D1").value
    With .Offset(1).Resize(k, 4)
        .value = Application.Transpose(arrFin)
        .EntireColumn.AutoFit
    End With
 End With
End Sub

如果您不知道如何添加必要的引用，请先运行下一个代码，它会自动添加。之后保存工作簿...

Sub addScrRunTimeRef()
  'Adding a reference to 'Microsoft Scripting Runtime':
  'In case of error ('Programmatic access to Visual Basic Project not trusted'):
  'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
  '         check "Trust access to the VBA project object model"
  Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\SysWOW64\scrrun.dll"
End Sub

Excel VBA: 将信息强制转换为逗号分隔的字符串

Excel VBA: coerce information into comma separated strings

excel

vba

string

comma

coerce