作者热门文章
- html - 出于某种原因,IE8 对我的 Sass 文件中继承的 html5 CSS 不友好?
- JMeter 在响应断言中使用 span 标签的问题
- html - 在 :hover and :active? 上具有不同效果的 CSS 动画
- html - 相对于居中的 html 内容固定的 CSS 重复背景?
我有两列代表一对多关系。我需要将其简化为 1:1 关系,其中 B 列中的许多内容由逗号连接。数据如下:
zipcode neighbors10001 1001010001 1001110001 1001610001 1001810001 1011910001 1019910003 10012
Here is what I want the output to look like:
zipcode neighbors10001 10010, 10011, 10012, 10016, 10018, 10019, 10199
There are 9000 records so I need to run a loop until end of record.
Now sure how to do this.
I figured it out, thanks everyone. Code share below:
Sub Concatenate()
Dim oldValue As String
Dim newValue As String
Dim result As String
Dim counter As Integer
oldValue = ""
newValue = ""
result = ""
counter = 1
For i = 2 To 9401
newValue = Worksheets("data").Cells(i, 1)
If (oldValue <> newValue) Then
Worksheets("result").Cells(counter, 1).NumberFormat = "@"
Worksheets("result").Cells(counter, 2).NumberFormat = "@"
Worksheets("result").Cells(counter, 1) = oldValue
Worksheets("result").Cells(counter, 2) = result
counter = counter + 1
result = ""
End If
If (result = "") Then
result = Worksheets("data").Cells(i, 2)
Else
result = result + "," + Worksheets("data").Cells(i, 2)
End If
oldValue = newValue
Next i
End Sub
最佳答案
太棒了,你弄清楚了。这是一个单独的任务,可以在不到一秒的时间内处理 15,000 条记录(当然是机器方面的 YMMV)。
我的数据:
代码:
Option Explicit
Sub GetByDictionary()
Dim wBk As Workbook: Set wBk = ThisWorkbook
Dim wSht As Worksheet: Set wSht = wBk.Sheets("Sheet5") 'Modify accordingly.
Dim oDict As Object: Set oDict = CreateObject("Scripting.Dictionary")
Dim lLastRow As Long: lLastRow = wSht.Cells(Rows.Count, 1).End(xlUp).row
Dim rZIP As Range: Set rZIP = wSht.Range("A2:A" & lLastRow)
Dim rNeigh As Variant, rCl As Range, rNewZIP As Range, rCl2 As Range
Dim Start As Variant
Start = Timer()
'Store zipcodes and neighbors into dictionary.
With oDict
For Each rCl In rZIP
rNeigh = rCl.Offset(, 1).Value
If Not .Exists(rCl.Value) And Not IsEmpty(rCl.Value) Then
.Add rCl.Value, rNeigh
Else
.Item(rCl.Value) = .Item(rCl.Value) & ", " & rNeigh
End If
Next rCl
End With
'Output them somewhere.
With wSht
.Range("E1").Value = "zipcode"
.Range("F1").Value = "neighbors"
Set rNewZIP = .Range("E2").Resize(oDict.Count)
rNewZIP.Value = Application.Transpose(oDict.Keys)
For Each rCl2 In rNewZIP
rCl2.Offset(0, 1).Value = oDict.Item(rCl2.Value)
Next rCl2
End With
Debug.Print Timer() - Start
End Sub
结果:
0.31 秒执行。
关于excel - 如何将 B 列中的唯一值与 A 列中的奇异值连接起来,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/20557489/
我是一名优秀的程序员,十分优秀!