1

次の列見出しを持つ Excel のテーブル (Table1) があります: 従業員名、ライセンス状態、およびライセンス ステータス。テーブルのサンプルは次のようになります。

John Adams  NY  Active
John Adams  PA  Active
John Adams  NJ  Inactive
Ralph Ames  MS  Active
Ed Turner   MS  Pending

アクティブなライセンス、保留中のライセンス、および非アクティブなライセンスの列を含む、従業員ごとに 1 つの行を持つ概要タブを設定したいと考えています。これらのセルには、適切な州コードのカンマ区切りのリストが表示されます。例えば：

Name        Active   Pending   Inactive
John Adams  NY, PA             NJ
Ralph Ames  MS
Ed Turner            MS

このカスタム リストにアクセスするための最良の方法に興味があります。私は以下の関数を書きましたが、これは正常に動作するようで、予想よりも高速に実行されますが、毎回テーブル全体をループするため効率が悪いようです。この関数を参照する数式を数百のセルに貼り付けました。

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

VBA を使用してテーブルに対して SQL のようなクエリを実行する方法はありますか?そのため、毎回テーブル全体ではなく SQL の結果をループするだけですか? これは、要約リストをアルファベット順に並べるのにも役立つと考えていました。または、私が考えていない他のより良い方法があるかもしれません。

4

1 に答える 1

1

では、スクリプト辞書を使用した例を次に示します。

私は1つのワークシートにこのテーブルを持っています:

州ごとのライセンスステータスの初期テーブルリスト

出力は、次のような要約データを含む新しいワークシートを生成する必要があります。

要約データを従業員名ごとに 1 行出力する

私はそれをかなり徹底的に文書化しようとしましたが、それについて質問がある場合はお知らせください.

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
于 2013-04-01T18:15:44.560 に答える