从多张纸的同一列中创建唯一的单词列表,并将其按字母顺序排序到动态命名范围

时间:2018-10-24 16:03:47

标签: excel vba excel-vba excel-formula

我有一个用户窗体,其中有一个组合框,其中有一个名称列表供用户选择。该列表必须是动态的,因为我希望用户能够在组合框中键入一个名称(如果尚不存在),但是还需要有一个已经存在的名称列表,以便他们选择。几年前,我在这里发现了一个类似的问题:Excel - All unique words in a range

这里的问题是,它仅适用于一张纸,而我看不到如何使用此方法从多张纸中提取数据,或者如何将名称自动按字母顺序排序。

这是我现在用来创建动态范围的子项,保留了到原始创建者的链接,以便在应归功的情况下给予功劳。

Sub SupplierListDynamic()
'Source: https://powerspreadsheets.com/
'For further information: https://powerspreadsheets.com/vba-create-named-range/
'declare object variable to hold reference to worksheet containing cell range
Dim myWorksheet As Worksheet

'declare variables to hold row and column numbers that define named cell range (dynamic)
Dim myFirstRow As Long
Dim myLastRow As Long
Dim myFirstColumn As Long
Dim myNamedRangeDynamic As Range    'declare object variable to hold reference to cell range
Dim myRangeName As String   'declare variable to hold defined name


Set myWorksheet = ThisWorkbook.Worksheets("List_Data")  'identify worksheet containing cell range
myFirstRow = 2  'identify first row and first column of cell range
myFirstColumn = 9
myRangeName = "SupplierList"    'specify defined name

With myWorksheet.Cells
    'find last row and last column of source data cell range
    myLastRow = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    'myLastColumn = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    'specify cell range
    Set myNamedRangeDynamic = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myFirstColumn))
End With

'create named range with workbook scope. Defined name is as specified.
'Cell range is as identified, with the last row and column being dynamically determined
ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRangeDynamic
End Sub

,但由于我正在使用{=INDEX(Sep[SUPPLIER],MATCH(0,COUNTIF($I$1:I1,Sep[SUPPLIER]),0))}从另一张纸上提取唯一值,所以未对其进行排序。当我对它们进行排序时,由于公式的工作原理,它们只是恢复到原始顺序。我宁愿使用VBA来完成所有这些工作,以将其保留在后台,但我需要一些帮助将所有内容捆绑在一起。

1 个答案:

答案 0 :(得分:0)

所以我最终弄明白了这一点。我最终要做的是将供应商名称的字符串值仅复制到下一列,然后清除原始列并将字符串值粘贴回它。然后,我使用上面的过程来动态创建命名范围,并使用下面的过程对范围进行排序。

这使我可以将新供应商添加到列表中,并相应地更新列表。我使用的两个支持过程如下。希望这会在将来对某人有所帮助。

Public Sub AddnewSupplier(supplier As String)
    Dim newRng As Range, supplierListColumn As Integer

    supplierListColumn = 9

    Set newRng = SelectFirstBlankCell(supplierListColumn, "List_Data")

    newRng.Value = supplier

    Call SupplierListDynamic
    Call sortSupplierList

End Sub

Public Sub sortSupplierList()
    Range("SupplierList").Sort Key1:=Worksheets("List_Data").Range("I1"), Order1:=xlAscending, Header:=xlYes
End Sub