2つの列にIDがあります。これらの列にはIDがあり、aまたはbに複数回表示されます。私がしたいのは、以下の例のようなバッチ番号を提供することです。関連するIDは1つのバッチの下に置かれます。2つの列からのエントリのリンク
excel/vbaでこれを行う方法の良いアイデアはありますか？私は15000行あります。これまで私は各行をループして1に2、その後2〜4などにタグを付けることを試みましたが、forループは突然ほぼ無制限になりました。私はコードを提供することには関心がない、それはもっと論理的な側面だ！
。うまくいけば、このバージョンはより効果的です。私はこの記事の最後にバグについてのメモを書きました。
このソリューションでは、グループの識別子を表すcGroupクラスを使用します。グループは、同じ行に表示されるcol Aおよびcol Bのすべての文字列として定義されます。したがって、グループのメンバシップは、ワークシートのどこかに同じグループの2つのメンバが存在する行が存在し、そのメンバの少なくとも1つがリストの別の行にも表示されることを意味します（両方の値が同じ行、彼らは彼ら自身のグループを持っています）。各グループには、作成時に割り当てられる元のクラスIDがありますが、後で別の親、グループ（後を参照）にリンクされる可能性があります。この場合、親グループのクラスIDが採用されます。
コードはリスト内で実行され、いずれかのキーが以前にリストにあった場合は、col Aおよびcol Bのキー値を既存のグループに割り当てます。以前にどちらも登場していない場合は、新しいクラスIDを持つ新しいグループが作成されます。以前に異なる行に表示され、異なるグループに割り当てられていた場合は、そのグループをリンクする必要があります。これは、あるグループを他のグループの親にすることによって、子>親関係の階層を形成することができます。子グループはその親のclassIDを採用します。ClassIDプロパティにはこのロジックが含まれています。このアプローチの大きな利点は、大規模反復を避けることです。ただし、子クラスの上位クラスID階層を検索して、下位クラスの子クラスIDを発見することはまだありません。
Scripting.Dictionaryを使用して、キーからそのクラスへの参照を提供します。これをコードで使用するには、[ツール]> [参照]のMicrosoft Scripting Runtimeライブラリへの参照を設定します。
キーデータを別のクラスcGrouperとして処理するコードを、単一のメソッドAllocateClassIDを使用して実装しました。これは、処理するワークシートの3列の領域を指定します.3つの列はKeyA、KeyB入力最初の2つの列の各行と、3番目の列の対応する出力クラス番号。コードのようなものになります。このクラスを使用するには：ここで
Public Sub run()
Dim oGrouper As New cGrouper
'// rTestData1 is a named range in the a worksheet that is 3 columns x n rows, containing n pairs of keys
'// in col1 and col2. the allocated class number is written into column 3 of the range
oGrouper.AllocateClassIDs [rTestData1]
End Sub
はcGrouperクラスのコードです：ここで
Option Explicit
'// This class will identify groups of related key values in two Key columns of a worksheet and then assign group numbers.
'// A group is defined as the set of Keys that appear on the same rows in the two key columns. So if A and B are on
'// row 3 and B and C on row 4, then A, B and C are in the same group, along with any other key values that share
'// the same relationship with each other.
'// Corollary: Keys are in different goups only if each key in the group never appears on the same row as any of the keys in any other group
'// Dictionaries
'// Lookup from a key value to the related class. Key value is a string that appears in colA or colB
Dim GroupMembers As New Scripting.Dictionary
'// Lookup to the groups that have already been created. The key is the GroupGroupID (integer assigned on creation)
Dim Groups As New Scripting.Dictionary
'// This subroutine does all the work
Public Sub AllocateClassIDs(Keys As Range)
'// First clear out the dictionaries
GroupMembers.RemoveAll
Groups.RemoveAll
g.Reset
'// Check the given ranges
If Keys.Columns.Count <> 3 Then
MsgBox "Range must have three columns - cannot process"
Exit Sub
End If
'// Set up references to the sub-ranges within the sheet
Dim KeysA As Range, KeysB As Range, ClassIDs As Range
Set KeysA = Keys.Columns(1)
Set KeysB = Keys.Columns(2)
Set ClassIDs = Keys.Columns(3)
Dim iRow As Integer, sAKey As String, sBKey As String
Dim iAGroup As cGroup, iBGroup As cGroup
'// Run down every row of the given range
For iRow = 1 To KeysA.Rows.Count
'// Get the key values from Col A and Col B
sAKey = KeysA.Cells(iRow)
sBKey = KeysB.Cells(iRow)
'// Check if these keys have already been found earlier
If GroupMembers.Exists(sAKey) Then Set iAGroup = GroupMembers.Item(sAKey) Else Set iAGroup = Nothing
If GroupMembers.Exists(sBKey) Then Set iBGroup = GroupMembers.Item(sBKey) Else Set iBGroup = Nothing
'// Now check the combination of possibilities:
Select Case True
Case iAGroup Is Nothing And iBGroup Is Nothing
'// Neither key was found so we need to create a new group to hold the class number
If Len(sAKey) > 0 Or Len(sBKey) > 0 Then
With New cGroup
'// Add the group to the dictionary of groups
Groups.Add .GroupID, .Self
'// Add the keys to the dictionary of group members. This links the key to the group
If Len(sAKey) > 0 Then GroupMembers.Add sAKey, .Self
If sAKey <> sBKey And Len(sBKey) > 0 Then GroupMembers.Add sBKey, .Self
End With
End If
Case iBGroup Is Nothing
'// Key in col A is already in a group from an earlier line, but key in Col B is not
'// we just add ColB key to the same group as the col A key
If Len(sBkey)>0 Then
Set iAGroup = GroupMembers.Item(sAKey)
GroupMembers.Add sBKey, iAGroup
End If
Case iAGroup Is Nothing
'// Key in Col B is already in a group, but Key in col A is not
'// We just add ColA key to the same group as the col B key
IF Len(sAkey)>0 Then
Set iBGroup = GroupMembers.Item(sBKey)
GroupMembers.Add sAKey, iBGroup
End IF
Case Else
'// They are both already in a group. That's fine if they are members of the same class but...
If iAGroup.ClassID <> iBGroup.ClassID Then
'// They are in DIFFERENT Classes so we must merge them together by settung
'// the class ID of one group to be the same as the other
'// Always use the lower-numbered class ID
If iAGroup.ClassID < iBGroup.ClassID Then
iBGroup.JoinGroupMembership iAGroup
Else
iAGroup.JoinGroupMembership iBGroup
End If
End If
End Select
Next iRow
'// Remember the last row
Dim iLastRow As Integer: iLastRow = iRow - 1
'// Assign the class numbers. This just makes sure each unique class has a number, starting at 1.
Dim ClassNumbers As New Scripting.Dictionary
Dim ix As Integer
Dim iGroup As cGroup
Dim iClassNumber As Integer
For ix = 0 To Groups.Count - 1
'// Get the next group object
Set iGroup = Groups.Item(Groups.Keys(ix))
'// Check if this is a "ROOT" group, i.e. the group ID is the same as the class ID
If iGroup.bIsRootGroup Then
iClassNumber = iClassNumber + 1
'If iClassNumber = 30 Then MsgBox "Classnumber 30"
'// Add it to the dictionary of class numbers
ClassNumbers.Add iGroup.ClassID, iClassNumber
End If
Next ix
'// Finally, we can assign the class numbers to the rows in the spreadsheet
Application.Calculation = xlCalculationManual
For ix = 1 To iLastRow
'// Put the relevant class number into column 3
ClassIDs.Cells(ix) = ClassNumbers.Item(GroupMembers.Item(KeysA.Cells(ix).Value).ClassID)
Next ix
Application.Calculation = xlCalculationAutomatic
MsgBox "done"
End Sub
は、cgroup内のクラスのコードここ
Option Explicit
'// Properties of the class
Public GroupID As Integer
'// The group master of this class (i.e. another group to which it has been joined)
'// Can be Nothing if not joined to any other group or if this is the master group
'// of a set of joined groups
Private memberOfGroup As cGroup
Private Sub class_initialize()
'// Assign an ID to myself
GroupID = g.NextGroupID
'// I am not a member of any other group
Set memberOfGroup = Nothing
End Sub
Public Sub JoinGroupMembership(NewLinkedGroup As cGroup)
'// Links this group to membership of another group.
'// Note that this group may already be a member of another group, in which case
'// group membership is changed on the parent group as well as this group
'// To avoid circular references, the group with the lower classid is always chosen to be the parent
If NewLinkedGroup.ClassID > Me.ClassID Then
NewLinkedGroup.JoinGroupMembership Me
Exit Sub
End If
'// If I am already member of a group, make sure my parent group
'// joins the new group
If Not memberOfGroup Is Nothing Then
memberOfGroup.JoinGroupMembership NewLinkedGroup
End If
'// Now set the new linked group to be my parent
Set memberOfGroup = NewLinkedGroup
End Sub
Public Function ClassID() As Integer
'// Returns the classID of this group's master group
'// Note that this is recursive, it will work up through the hierarchy of
'// parent groups until it hits the group with no parent.
'// Check if I am the master group
If memberOfGroup Is Nothing Then
'// Return my GroupID as the classID
ClassID = GroupID
Else
'// Return the classID of my parent
ClassID = memberOfGroup.ClassID
End If
End Function
Public Function bIsRootGroup() As Boolean
'// Returns true if this group is not a member of another group
bIsRootGroup = memberOfGroup Is Nothing
End Function
Public Function Self() As cGroup
Set Self = Me
End Function
です私が名前をつけたモジュールのコードです
Option Explicit
'// Global register of Group ID
Private gMaxGroupNumber As Integer
'// Method to get the next available GroupID
Public Function NextGroupID() As Integer
gMaxGroupNumber = gMaxGroupNumber + 1
NextGroupID = gMaxGroupNumber
End Function
'// Method to reset the groupID
Public Sub Reset()
gMaxGroupNumber = 0
End Sub
バグについて：私の以前のバージョンのコードでは、グループへの親クラスIDの単純な割り当てであったため、グループ階層は機能しませんでした。グループが制御された順序で結合されている限り、これは問題ありませんが、2つの別々のグループがすでに形成されている場合、2つのグループを後で結合すると、以前にリンクされたメンバーが分離される可能性があります。彼らは効果的に孤児になった。
仮定：
、その後、このコードはあなたのために動作します：これは深刻なバグがありました、私は18Octに掲載コードの19Octや他のいくつかの欠点に変更がある
Sub tgr()
Const Link1Col As String = "A"
Const Link2Col As String = "B"
Const LinkIDCol As String = "C"
Dim ws As Worksheet
Dim linkColumns(1 To 2) As Range
Dim FoundLink As Range
Dim LinkID As Long
Dim i As Long
Set ws = ActiveWorkbook.ActiveSheet
Set linkColumns(1) = ws.Range(Link1Col & "1", ws.Cells(ws.Rows.Count, Link1Col).End(xlUp))
Set linkColumns(2) = Intersect(linkColumns(1).EntireRow, ws.Columns(Link2Col))
Intersect(linkColumns(1).EntireRow, ws.Columns(LinkIDCol)).ClearContents
LinkID = 0
For i = linkColumns(1).Row To linkColumns(1).Row + linkColumns(1).Rows.Count - 1
If Len(ws.Cells(i, LinkIDCol).Value) = 0 Then
LinkID = LinkID + 1
ws.Cells(i, LinkIDCol).Value = LinkID
Set FoundLink = linkColumns(1).Find(ws.Cells(i, Link2Col).Value, , xlValues, xlWhole)
If Not FoundLink Is Nothing Then
Do
ws.Cells(FoundLink.Row, LinkIDCol).Value = LinkID
Set FoundLink = linkColumns(1).Find(ws.Cells(FoundLink.Row, Link2Col).Value, , xlValues, xlWhole)
Loop While Not FoundLink Is Nothing
End If
End If
Next i
End Sub
こんにちはタイガー。これを試してみてください。最初の列には必ずしも最初のリンクが含まれているとは限りません。 – Wickey312
「関連する」IDとはどういう意味ですか？同じまたは部分一致を意味しますか？バッチ番号はIDからどのように派生していますか？ – JohnRC
こんにちは。関連IDはリンクされた関係です。したがって、上のスクリーンショットでは、a1はb1にリンクし、b1はc1にリンクするので、すべてのバッチまたはより簡単な用語の依存関係になります。バッチ番号は、1つのバッチに関するすべての関連する依存関係の一意の識別子です。 – Wickey312
後のエントリは以前のエントリにリンクできますか？例えば行5はX1> A1 – JohnRC