将Excel表中的项目列表转换为逗号分隔的字符串 [英] Convert list of items in an Excel Table to comma-separated string
问题描述
John Adams NY Active
John Adams PA Active
John Adams NJ无效
Ralph Ames MS Active
Ed Turner MS待定
我想设置一个摘要选项卡，每个员工有一行，具有活动许可证，待处理许可证和非活动许可证的列，这些单元格将显示适当状态代码的逗号分隔列表。例如：
名称Active Pending Inactive
John Adams NY，PA NJ
Ralph Ames MS
Ed Turner MS
我只是想获得这个自定义列表的最佳方法。我写了下面的函数，这似乎工作正常，它的运行速度比我预期的要快，但是它似乎效率很低，因为它每次循环遍历整个表，我已经将引用该函数的公式粘贴到几百个单元格： / p>
函数comma_state_list（the_name As String，the_status As String）As String
Dim ws As Worksheet
Dim oLo作为ListObject
Dim oCol As ListColumns
设置ws = Worksheets（State Licenses）
设置oLo = ws.ListObjects（Table1）
设置oCol = oLo.ListColumns
对于i = 1 To oLo.ListRows.Count
如果oLo.Range（i，1）.Value = the_name And oLo.Range（i，3）= the_status Then
comma_state_list = comma_state_list& oLo.Range（i，4）&
End If
Next i
如果Len（comma_state_list）= 0然后
comma_state_list =
Else
comma_state_list =左（comma_state_list，Len（comma_state_list） - 2）
结束如果
结束函数
有没有办法使用VBA来对表执行类似SQL的查询，所以我只是循环遍历SQL结果，而不是每次都是整个表？我在想，这将有助于将摘要列表字母排序。或者也许还有其他一些更好的方式，我没有想到。
好的，所以这里是一个使用脚本语言的例子。
我在一个工作表上有这个表：
输出应该生成一个包含摘要数据的新工作表，如：
我试图很好地记录它，但是如果您对此有任何疑问，请告知我。
Option Explicit
Sub Test（）
Dim wsCurr As Worksheet：设置wsCurr = ActiveSheet
Dim wsNew As Worksheet'输出容器'
Dim rowNum As Long'row number for output'
'脚本字典：'
Dim inactiveDict As Object
Dim activeDict As Object
Dim key As Variant
'表变量'
Dim rng As Range'data of data'
Dim r As Long'row iterator for the table range。'
'information关于每个员工/行'
Dim empName As String
Dim state As String
Dim status As String
'创建我们的字典：'
设置activeDict = Nothing
设置inactiveDict = Nothing
设置activeDict = CreateObject（Scripting.Dictionary）
设置inactiveDict = CreateObject（Scripting.Dictionary）
设置rng = Range（A1：C6）'更好地动态设置，这只是一个例子'
对于r = 2 To rng.Rows.Count
empName = rng（r， 1）.Value
state = rng（r，2）.Value
status = rng（r，3）.Value
选择案例UCase（status）
caseACTIVE
AddItemToDict activeDict，empName，state
案例INACTIVE
AddItemToDict inactiveDict，empName，state
结束选择
下一个
'添加一个新的工作表与摘要数据'
设置wsNew = Sheets.Add（之后：= wsCurr）
与wsNew
.Cells（1，1）.Value =Name
.Ce lls（1，2）.Value =Active
.Cells（1，3）.Value =Inactive
rowNum = 2
'创建具有活动许可证的初始表
对于每个键在activeDict
.Cells（rowNum，1）.Value = key
.Cells（rowNum，2）.Value = activeDict（key）
rowNum = rowNum + 1
下一个
'现在，通过这个列表中的非活动许可证
对于每个键在inactiveDict
如果activeDict.Exists（ key）然后
rowNum = Application.Match（key，.Range（A：A），False）
其他：
rowNum = Application.WorksheetFunction.CountA（wsNew.Range（ A：A））+ 1
.Cells（rowNum，1）.Value = key
End If
.Cells（rowNum，3）.Value = inactiveDict ）
下一个
结束
'清理：
设置activeDict =没有
设置inactiveDict =没有
End Sub
Sub AddItemToDict（dict As Object，empName As St ring，state As String）
'，因为我们将对两个字典对象使用相同的方法，'
'最好是对这个动作进行子例程：'
Dim key As Variant
'检查这个员工是否已经存在'
如果UBound（dict.Keys）= -1然后
dict.Add empName，状态
否则：
如果没有dict.Exists（empName）然后
'如果IsError（Application.Match（empName，dictKeys，False））然后
'的雇员不存在，所以添加到dict'
dict.Add empName，state
Else：
'employee确实存在，所以更新列表：'
'连接状态列表'
state = dict（empName）& ，&状态
'删除字典条目'
dict.Remove empName
'添加更新的字典条目'
dict.Add empName，状态
结束If
结束如果
End Sub
I have a table in Excel (Table1) that has these column headings: employee name, state licensed, and license status. A sample of the table would be:
John Adams NY Active
John Adams PA Active
John Adams NJ Inactive
Ralph Ames MS Active
Ed Turner MS Pending
I want to set up a summary tab that has one row per employee with a column for active licenses, pending licenses, and inactive licenses, and those cells would display a comma-separated list of the appropriate state codes. For example:
Name Active Pending Inactive
John Adams NY, PA NJ
Ralph Ames MS
Ed Turner MS
I'm just curious about the best way to get to this custom list. I wrote the function below which seems to work fine, and it runs faster than I expected, but it just seems inefficient because it loops through the entire table every time, and I've pasted formulas referencing this function to a few hundred cells:
Function comma_state_list(the_name As String, the_status As String) As String
Dim ws As Worksheet
Dim oLo As ListObject
Dim oCol As ListColumns
Set ws = Worksheets("State Licenses")
Set oLo = ws.ListObjects("Table1")
Set oCol = oLo.ListColumns
For i = 1 To oLo.ListRows.Count
If oLo.Range(i, 1).Value = the_name And oLo.Range(i, 3) = the_status Then
comma_state_list = comma_state_list & oLo.Range(i, 4) & ", "
End If
Next i
If Len(comma_state_list) = 0 Then
comma_state_list = ""
Else
comma_state_list = Left(comma_state_list, Len(comma_state_list) - 2)
End If
End Function
Is there a way to maybe use VBA to run a SQL-like query against the table so I'm just looping through the SQL result instead of the entire table every time? I was thinking this would help to alphabetize the summary list too. Or maybe there's some other better way I'm not thinking of.
OK, so here is an example using Scripting Dictionaries.
I have this table on one worksheet:
And the output should produce a new worksheet with summary data like:
I tried to document it pretty thoroughly but let me know if you have any questions about it.
Option Explicit
Sub Test()
Dim wsCurr As Worksheet: Set wsCurr = ActiveSheet
Dim wsNew As Worksheet 'output container'
Dim rowNum As Long 'row number for output'
'Scripting dictionaries:'
Dim inactiveDict As Object
Dim activeDict As Object
Dim key As Variant
'Table variables'
Dim rng As Range 'table of data'
Dim r As Long 'row iterator for the table range.'
'information about each employee/row'
Dim empName As String
Dim state As String
Dim status As String
'Create our dictionaries:'
Set activeDict = Nothing
Set inactiveDict = Nothing
Set activeDict = CreateObject("Scripting.Dictionary")
Set inactiveDict = CreateObject("Scripting.Dictionary")
Set rng = Range("A1:C6") 'better to set this dynamically, this is just an example'
For r = 2 To rng.Rows.Count
empName = rng(r, 1).Value
state = rng(r, 2).Value
status = rng(r, 3).Value
Select Case UCase(status)
Case "ACTIVE"
AddItemToDict activeDict, empName, state
Case "INACTIVE"
AddItemToDict inactiveDict, empName, state
End Select
Next
'Add a new worksheet with summary data'
Set wsNew = Sheets.Add(After:=wsCurr)
With wsNew
.Cells(1, 1).Value = "Name"
.Cells(1, 2).Value = "Active"
.Cells(1, 3).Value = "Inactive"
rowNum = 2
'Create the initial table with Active licenses'
For Each key In activeDict
.Cells(rowNum, 1).Value = key
.Cells(rowNum, 2).Value = activeDict(key)
rowNum = rowNum + 1
Next
'Now, go over this list with inactive licenses'
For Each key In inactiveDict
If activeDict.Exists(key) Then
rowNum = Application.Match(key, .Range("A:A"), False)
Else:
rowNum = Application.WorksheetFunction.CountA(wsNew.Range("A:A")) + 1
.Cells(rowNum, 1).Value = key
End If
.Cells(rowNum, 3).Value = inactiveDict(key)
Next
End With
'Cleanup:
Set activeDict = Nothing
Set inactiveDict = Nothing
End Sub
Sub AddItemToDict(dict As Object, empName As String, state As String)
'since we will use the same methods on both dictionary objects, '
' it would be best to subroutine this action:'
Dim key As Variant
'check to see if this employee already exists'
If UBound(dict.Keys) = -1 Then
dict.Add empName, state
Else:
If Not dict.Exists(empName) Then
'If IsError(Application.Match(empName, dictKeys, False)) Then
'employee doesn't exist, so add to the dict'
dict.Add empName, state
Else:
'employee does exist, so update the list:'
'concatenate the state list'
state = dict(empName) & ", " & state
'remove the dictionary entry'
dict.Remove empName
'add the updated dictionary entry'
dict.Add empName, state
End If
End If
End Sub
这篇关于将Excel表中的项目列表转换为逗号分隔的字符串的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
