用值匹配的單元格創建命名範圍？

-1

Employee Company 
970423-4829 Vete 
970212-2398 AlfaLaval 
970212-2398 DeLaval 
970423-4829 Verktyg 
970423-4829 Verktyg 
960822-7587 Arla 
970423-4829 test3 
961225-7590 Test 
970911-1287 Kamel 
970911-1287 Kanel

我想創建一個包含一定的員工的所有公司線命名範圍。

如果「員工」爲970212-2398，那麼我想的範圍是

AlfaLaval 
DeLaval

如果「員工」爲970911-1287，那麼我想的範圍是

Kamel 
Kanel

這可能使用Excel和/或VBA嗎？

來源

2014-10-29 user1283776

是員工ID排序？ – 2014-10-29 12:17:10

你如何選擇你想創建名稱的「某位員工」？你將使用這些命名範圍來做什麼？「表」真的是「表」，還是僅僅是一個2列的列表？如果它是一個表，它的名字是什麼？你到目前爲止完成這項任務的目的是什麼？ – 2014-10-29 12:27:04

它實際上是一個Excel表格。這些ID沒有排序。我們可以假裝「某某emplyee」位於A1。我將使用範圍/結果列表作爲數據驗證下拉列表。 – user1283776 2014-10-29 12:33:42

似乎有一些反對意見，表明你會更好地與另一種解決方案，但這看起來像一個Scripting.Dictionary對象的理想子，我喜歡與他們一起工作，所以在這裏你去。

Sub create_employee_named_ranges() 
    Dim n As Long, r As Long, vEMP As Variant 
    Dim dEMPs As New Scripting.Dictionary 
    dEMPs.CompareMode = TextCompare 

    With ActiveSheet 
     For r = 2 To .Cells(Rows.Count, 1).End(xlUp).Row 
      If Not dEMPs.Exists(.Cells(r, 1).Value) Then 
       dEMPs.Add Key:=.Cells(r, 1).Value, _ 
        Item:=Chr(39) & .Name & Chr(39) & Chr(33) & .Cells(r, 2).Address 
      Else 
       dEMPs.Item(.Cells(r, 1).Value) = _ 
        dEMPs.Item(.Cells(r, 1).Value) & Chr(44) & Chr(39) & .Name & Chr(39) & Chr(33) & .Cells(r, 2).Address 
      End If 
     Next r 
    End With 

    With ActiveWorkbook 
     For n = 1 To .Names.Count 
      If Left(.Names(n).Name, 4) = "enr_" Then _ 
       .Names(n).Delete 
     Next n 
     For Each vEMP In dEMPs 
      .Names.Add Name:="enr_" & Replace(vEMP, Chr(45), Chr(95)), _ 
       RefersTo:=Chr(61) & dEMPs.Item(vEMP) 
     Next vEMP 
    End With 

    dEMPs.RemoveAll: Set dEMPs = Nothing 
End Sub

你將不得不進入VBE的工具，參考並添加Microsoft Scripting Runtime到列表中。請注意，我無法使用實際的員工標識符，因爲破折號是命名範圍名稱中的非法字符（可能是因爲它們用於減法），所以我用下劃線替換了它們。

來源

2014-10-29 14:16:12 Jeeped

如果你想要做的是生成一個下拉列表，根據選擇一個特定的員工，我建議你從該表中的列中的過濾器中選擇員工。然後，您可以在工作表變更事件時自動運行VBA宏，或者使用設置爲運行宏的按鈕手動運行VBA宏，以生成下拉列表。

以下示例將根據您爲員工ID（或多個ID）選擇的內容在單元格A1中設置「公司下拉列表」。

Option Explicit 
Sub MakeCompanyList() 
    Dim LO As ListObject 
    Dim colCompanies As Collection 
    Dim I As Long 
    Dim RW As Long 
    Dim S() As String 

Set LO = Worksheets("sheet1").ListObjects("Table1") 

'Get company list from the visible rows 
Set colCompanies = New Collection 
On Error Resume Next 
With LO.ListColumns("Company").DataBodyRange 
    For I = 1 To .Rows.Count 
     If .Rows(I).Hidden = False Then _ 
      colCompanies.Add .Rows(I).Value, CStr(.Rows(I).Value) 
    Next I 
End With 
On Error GoTo 0 

ReDim S(1 To colCompanies.Count) 
For I = 1 To UBound(S) 
    S(I) = colCompanies(I) 
Next I 

With Worksheets("Sheet1").Range("A1").Validation 
    .Delete 
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 
     xlBetween, Formula1:=Join(S, ",") 
     .IgnoreBlank = True 
     .InCellDropdown = True 
     .InputTitle = "Select a Company" 
     .ErrorTitle = "" 
     .InputMessage = "Selec a Company" 
     .ErrorMessage = "Oops" 
     .ShowInput = True 
     .ShowError = True 
    End With 
End Sub

來源

2014-10-29 22:59:53

用值匹配的單元格創建命名範圍？

回答

相關問題