如何解决如何根据标准串联细胞范围
我在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,10).Value = str
Next x
End Sub
我没有得到所需的正确结果,
感谢您的支持
谢谢!
Moheb Labib
解决方法
如果您具有带有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,COUNTIF($A:$A,A2),"")
然后填写。
您也可以使用Excel 2010+中可用的Power Query
来完成此操作
- 选择要包括的整个范围
- *由于存在空白行,因此无法自动选择
- 在Excel 2016+中:
Data --> Get & Transform --> From Table/Range
- 我不确定较早的版本,您可以从该版本下载免费的MS加载项以实现此功能。
- 打开PQ编辑器后,选择
Home --> Advanced Editor
并将下面的M Code
粘贴到打开的窗口中。- 将第2行中的表格名称更改为打开PQ时生成的表格的名称。
有关说明,请检查“应用步骤”窗口中的项目。如果将光标悬停在任何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"}),//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",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","Index"}),//Remove bottom row which will be blank
#"Removed Bottom Rows" = Table.RemoveLastN(#"Removed Columns1",1)
in
#"Removed Bottom Rows"
,
请尝试下一个代码。由于您没有回答我的澄清问题,因此该代码在以下假设下工作:出现意味着对每个串联项目进行计数:
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,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
,
首先,您以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
是
声明为 Variant 。
除此之外,我只是剪掉一些位,并添加了一个例程来正确计算和格式化数据。
以前,您使用的是Rng.Cells(x,1)
,但是x
的值在整个Cel
循环中不会改变,因此您需要访问Cel.Row
属性来查找找出问题所在的行。
y
变量存储x
的第一次出现以用于显示。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。