Excel VBA基于独特的logging和薪水制作不同的集合

我有下面的数据

Empid Empname salary Company location status xx Jhon 100 IBM us x1 Phil 50 IBM us x2 Karl 30 IBM us x3 Steve 20 IBM us x4 jacob 70 Oracle uk x5 jason 30 Oracle uk x6 stuart 50 Oracle uk zz jay 150 Oracle uk x10 Steve1 20 IBM ind x9 Steve2 20 IBM nj 

我必须根据公司和地点分开logging。 所以我会得到两套logging。

第一套

 Empid Empname salary company Location status xx Jhon 100 IBM us x1 Phil 50 IBM us x2 Karl 30 IBM us x3 Steve 20 IBM us 

第二套

  Empid Empname salary company Location status x4 jacob 70 Oracle uk x5 jason 30 Oracle uk x6 stuart 50 Oracle uk zz jay 150 Oracle uk 

在上面的XX组中，zz是主logging。 我检查x1 + x2 + x3 = xx工资。 如果它是平等的，那么我写在匹配列的状态，否则我会忽略。 原始工作表中的最后两行应该忽略，因为它没有主logging。

 Sub Tester() Const COL_COMP As Integer = 4 Const COL_LOC As Integer = 5 Const VAL_DIFF As String = "XXdifferentXX" Dim d As Object, sKey As String Dim rw As Range, opt As String, rngData As Range Dim rngCopy As Range Dim FirstPass As Boolean With Sheet1.Range("A1") Set rngData = .CurrentRegion.Offset(1).Resize( _ .CurrentRegion.Rows.Count - 1) End With Set rngCopy = Sheet2.Range("A2") Set d = CreateObject("scripting.dictionary") FirstPass = True redo: For Each rw In rngData.Rows sKey = rw.Cells(COL_COMP).Value & "<>" & _ rw.Cells(COL_LOC).Value 'Here i have to make different sets of data. Next rw If FirstPass Then FirstPass = False GoTo redo End If End Sub 

Answer 1

如果有人遇到类似的问题，请使用下面的解决scheme

问候，拉杰

 Sub tester() Const COL_EID As Integer = 1 Const COL_comp As Integer = 4 Const COL_loc As Integer = 5 Const COL_sal As Integer = 3 Const COL_S As Integer = 6 Const VAL_DIFF As String = "XXdifferentXX" Dim d As Object, sKey As String, sKey1 As String, id As String Dim rw As Range, opt As String, rngData As Range Dim rngCopy As Range, goodId As Boolean, goodId1 As Boolean Dim FirstPass As Boolean, arr, arr1 Dim sal As Integer Dim colsal As Integer Dim mastersal As Integer Dim status As Boolean Dim status1 As Boolean With Sheet1.Range("A1") Set rngData = .CurrentRegion.Offset(1).Resize( _ .CurrentRegion.Rows.Count - 1) End With Set rngCopy = Sheet2.Range("A1") FirstPass = True SecondPass = False status = False Set a = CreateObject("scripting.dictionary") Set d = CreateObject("scripting.dictionary") redo: For Each rw In rngData.Rows sKey = rw.Cells(COL_comp).Value & "<>" & _ rw.Cells(COL_loc).Value sKey1 = rw.Cells(COL_comp).Value & "<>" & _ rw.Cells(COL_loc).Value colsal = rw.Cells(COL_sal).Value If FirstPass Then id = rw.Cells(COL_EID).Value goodId = (id = "xx" Or id = "zz") If d.exists(sKey) Then arr = d(sKey) 'can't modify the array in situ... If goodId Then arr(0) = True d(sKey) = arr 'return [modified] array Else d.Add sKey, Array(goodId) End If End If If SecondPass Then id = rw.Cells(COL_EID).Value goodId1 = (id = "xx" Or id = "zz") If d(sKey)(0) = True Then If goodId1 Then mastersal = rw.Cells(COL_sal).Value If a.exists(sKey1) Then arr1 = a(sKey1) 'can't modify the array in situ... If goodId1 = False Then sal = sal + colsal If mastersal = sal Then arr1(0) = True 'If goodId1 Then arr1(0) = True a(sKey1) = arr1 'return [modified] array Else a.Add sKey1, Array(status) sal = 0 If goodId1 = False Then sal = sal + colsal End If End If End If If FirstPass = False And SecondPass = False Then If d(sKey)(0) = True Then If a(sKey1)(0) = True Then rw.Copy rngCopy Set rngCopy = rngCopy.Offset(1, 0) End If End If End If Next rw If SecondPass Then SecondPass = False GoTo redo End If If FirstPass Then FirstPass = False SecondPass = True colsal = 0 GoTo redo End If End Sub