如何根据标准连接单元格范围

Question

我在 excel 中有 2 列如下：

CutNo    Data       
1        A          
1        B
1        C

2        A          
2        B

3        A  

如果 Cut No 相同，我想连接列数据的数据并将其放在另一个名为 Concatenate 的列中并计算出现次数并将其放在另一列中，如下所示

CutNo    Data       Concatenate     Occurrences
1        A          A & B & C           1 
1        B
1        C

2        A          A & B               1
2        B

3        A          A                   1

我使用下面的代码

    Sub Unique()
    Dim Rng, Cel As Range
    Dim lr As Long
    Dim x As Integer
    Dim str As String
    lr = Sheets("Report").Cells(Rows.count, 1).End(xlUp).Row
    Set Rng = Sheets("Report").Range("A2:A" & lr)
    For x = 1 To Rng.count
    For Each Cel In Rng.Cells
    If Cel.Value = x Then
    str = str & Rng.Cells(x, 1).Offset(0, 7) & ","
    End If
    Next Cel
    Rng.Cells(x, 1).Offset(0, 10).Value = str
    Next x
    End Sub

我没有得到我需要的正确结果，

感谢您的支持

谢谢，问候

莫赫布拉比布

Answer 1

如果您有带有FILTER 函数的 Excel O365，则不需要 VBA：

(注意：我假设Occurrences可以通过计算CutNo的行数来计算。如果你的意思是别的，请澄清 )

C2: =IF(AND(A2<>A1,A2<>""),TEXTJOIN(" & ",TRUE,FILTER($B:$B,$A:$A=A2)),"")
D2: =IF(AND(A2<>A1,A2<>""),COUNTIF($A:$A,A2),"")

然后填写。

您也可以使用 Excel 2010+ 中提供的 Power Query 来执行此操作

• 选择要包含的整个范围
  • *无法自动选择，因为存在空白行
• 在 Excel 2016+ 中：Data --> Get & Transform --> From Table/Range
  • 我不确定早期版本是否可以下载免费的 MS 插件来实现此功能。
• 当 PQ 编辑器打开时，选择 Home --> Advanced Editor 并将下面的 M Code 粘贴到打开的窗口中。
  • 将第 2 行中的 Table name 更改为您打开 PQ 时生成的 Table 的名称。

有关解释，请检查“应用步骤”窗口中的项目。如果您将光标悬停在任何i 图标上，您将看到相关的评论；如果你双击一个齿轮，它会打开一个对话窗口，这样你就可以检查做了什么。

• 关闭并加载到：我选择原始数据旁边的列，但还有其他方法可以做到这一点。

M 码

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"CutNo", Int64.Type}, {"Data", type text}}),

    //make the grouping easier, else we'd have a group with the blank rows
    #"Removed Blank Rows" = Table.SelectRows(#"Changed Type", each not List.IsEmpty(List.RemoveMatchingItems(Record.FieldValues(_), {"", null}))),
    
    //Group by CutNo -- hence no need to sort
    #"Grouped Rows" = Table.Group(#"Removed Blank Rows", {"CutNo"}, {{"Grouped", each _, type table [CutNo=nullable number, Data=nullable text]}}),

    //add a blank row at the bottom of each grouped table (each CutNo group)
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "addBlankRow", each Table.InsertRows([Grouped],
            Table.RowCount([Grouped]),
            {[CutNo=null, Data=null]})),

    //remove unneded columns
    #"Removed Columns" = Table.RemoveColumns(#"Added Custom",{"CutNo", "Grouped"}),
    #"Added Custom1" = Table.AddColumn(#"Removed Columns", "Custom", each Table.Column([addBlankRow],"Data")),

    //Concatenate the "Data"
    #"Extracted Values" = Table.TransformColumns(#"Added Custom1", {"Custom", each Text.Combine(List.Transform(_, Text.From), " & "), type text}),

    //Count the rows (subtract one since last row will be blank
    #"Added Custom2" = Table.AddColumn(#"Extracted Values", "Custom.1", each Table.RowCount([addBlankRow])-1),

    //Expand the Table column to put a blank row between each group of CutNo
    #"Expanded addBlankRow" = Table.ExpandTableColumn(#"Added Custom2", "addBlankRow", {"CutNo"}, {"addBlankRow.CutNo"}),

    //Add Index column so we can null out where there should be empty cells in the Concatenate Column
    #"Added Index" = Table.AddIndexColumn(#"Expanded addBlankRow", "Index", 0, 1, Int64.Type),
    #"Added Custom3" = Table.AddColumn(#"Added Index", "Concatenate", each 
        if [Index] = 0 
            then [Custom]
            else if [addBlankRow.CutNo] = null 
            then null 
            else if [addBlankRow.CutNo] = #"Expanded addBlankRow"[addBlankRow.CutNo]{[Index]-1} 
            then null 
            else [Custom]),

    //Blank cells in the Occurrence column if blank in the CutNo column
    #"Added Custom4" = Table.AddColumn(#"Added Custom3", "Occurrences", each 
        if [Concatenate] = null then null 
        else [Custom.1]),

    //Remove unneeded columns        
    #"Removed Columns1" = Table.RemoveColumns(#"Added Custom4",{"addBlankRow.CutNo", "Custom", "Custom.1", "Index"}),

    //Remove bottom row which will be blank
    #"Removed Bottom Rows" = Table.RemoveLastN(#"Removed Columns1",1)
in
    #"Removed Bottom Rows"

Answer 2

首先，VBA 格式的数据：

Cells.Clear
Cells(2, 1) = "1"
Cells(2, 2) = "A"
Cells(3, 1) = "1"
Cells(3, 2) = "B"
Cells(4, 1) = "1"
Cells(4, 2) = "C"
Cells(6, 1) = "2"
Cells(6, 2) = "A"
Cells(7, 1) = "2"
Cells(7, 2) = "B"
Cells(9, 1) = "3"
Cells(9, 2) = "A"

第二，你的代码重做：

Dim rng As Range, Cel As Range
Dim lr As Long
Dim x As Integer, y As Integer
Dim str As String
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("A2:A" & lr)
For x = 1 To rng.Count
str = ""
y = 0
For Each Cel In rng
If Cel.Value = x Then
str = str & rng.Cells(Cel.Row - 1, 2) & ","
If y = 0 Then y = Cel.Row - 1
End If
Next Cel
If y>0 Then rng.Cells(y, 4) = Left(str, Len(str) - 1)
Next x

输出：

注意事项：

我忽略了“发生”，因为它看起来很模糊。

Dim rng, Cel As Range 应该是 Dim rng As Range, Cel As Range，否则 rng 是 声明为变体。

除此之外，我刚刚修剪了一些位，并添加了一个例程来正确计算和格式化数据。

以前，您使用的是Rng.Cells(x, 1)，但x 的值在整个Cel 循环中不会改变，因此您需要访问Cel.Row 属性以找出相关行的位置。

y 变量存储x 的第一次出现以供显示。

Answer 3

请尝试下一个代码。由于您没有回答我的澄清问题，因此代码假设出现次数意味着对每个连接项进行计数：

Sub testConcatenateOnCriteria()
  Dim sh As Worksheet, lastRow As Long, dict As New Scripting.Dictionary
  Dim i As Long, count As Long, strVal As String, arr As Variant
  
  Set sh = ActiveSheet 'use here your sheet
  lastRow = sh.Range("A" & Rows.count).End(xlUp).Row

  For i = 2 To lastRow
    strVal = sh.Range("A" & i).Value
    If sh.Range("B" & i).Value <> "" Then
        If Not dict.Exists(strVal) Then
            dict.Add strVal, Array(sh.Range("B" & i).Value, 1, i)
        Else
            dict(strVal) = Array(dict(strVal)(0) & sh.Range("B" & i).Value, dict(strVal)(1) + 1, dict(strVal)(2))
        End If
    End If
  Next i
  ReDim arr(1 To lastRow, 1 To 2)
  arr(1, 1) = "Concatenate": arr(1, 2) = "Occurrences"
  For i = 0 To dict.count - 1
    arr(dict(dict.Keys(i))(2), 1) = dict(dict.Keys(i))(0): arr(dict(dict.Keys(i))(2), 2) = dict(dict.Keys(i))(1)
  Next i

  sh.Range("C1").Resize(UBound(arr), 2).Value = arr
End Sub