Excel宏来比较行 [英] Excel macro to comparison of rows

问题描述

Sheet1中的Excel数据

我正在尝试做下面的示例，无法做到这一点。 pre> id Sysid选项状态
XYZ XT打开status_1
US XT关闭Status_1
US XT打开Stauts_2
NJ XT打开状态_
IND VX关闭Status_1
BAN VX打开Status_1
CHN XY打开Status_1
YST xy关闭Status_1


在上面的数据Status_1和Sysid中定义了唯一的记录，基于这个条件，我必须找出哪些记录具有与该独特记录组合有明显的差异。如果选项不同，我必须使用excel宏将该数据复制到不同的工作表。这应该仅适用于ID的US和CHN.Suppose，如果id为US，则应与基于sysid和Status的匹配记录进行比较。任何帮助赞赏。

输出如下所示：

  XYZ XT Open status_1 
 US XT关闭Status_1 
 CHN XY打开Status_1 
 YST xy关闭Status_1 
  

解决方案

编辑以包含US或CHN的测试

  Sub Tester（）
 
 Const COL_ID As Integer = 1 
 Const COL_SYSID As Integer = 2 
 Const COL_STATUS As Integer = 4 
 Const COL_OPTION As Integer = 3 
 Const VAL_DIFF As String =XXdifferentXX
 
 Dim d As Object，sKey As String，id As String 
 Dim rw As Range，opt As String，rngData As Range 
 Dim rngCopy As Range，goodId As Boolean 
 Dim FirstPass As Boolean，arr 
 
 With Sheet1.Range（A1）
设置rngData = .CurrentRegion.Offset（1）。调整大小（_ 
 .CurrentRegion.Rows.Count  -  1）
结束
设置rngCopy = Sheet1。范围（F2）
 
设置d = CreateObject（scripting.dictionary）
 FirstPass = True 
 
重做：
对于每个rw In rngData.Rows 
 
 sKey = rw.Cells（COL_SYSID）.Value& <> 中&安培; _ 
 rw.Cells（COL_STATUS）.Value 
 
如果FirstPass然后
'找出哪些组合有不同的选项值
'和至少一个id = US或CHN 
 id = rw.Cells（COL_ID）.Value 
 goodId =（id =US或id =CHN）
 opt = rw.Cells（COL_OPTION）.Value 
 
如果d.exists（sKey）然后
 arr = d（sKey）'不能原位修改数组... 
如果arr（0）<> ; opt then arr（0）= VAL_DIFF 
如果goodId然后arr（1）= True 
d（sKey）= arr'return [modified] array 
 Else 
 d.Add sKey， Array（opt，goodId）
 End If 
 
 Else 
'第二遍 - 只复制不同选项
'和id = US或CHN 
的行如果d（sKey）（0）= VAL_DIFF和d（sKey）（1）= True然后
 rw.Copy rngCopy 
设置rngCopy = rngCopy.Offset（1，0）
结束If 
结束如果
 
下一个rw 
如果FirstPass然后
 FirstPass = False 
 GoTo重做
如果
 
 End Sub 
  

I am trying to do below example, not able to do it.

Excel Data in Sheet1:

id     Sysid     option      status
XYZ      XT       Open       status_1
US     XT       Close      Status_1
US      XT       Open       Stauts_2
NJ      XT       Open   Status_2
IND     VX       Close      Status_1
BAN     VX       Open       Status_1
CHN     XY       Open       Status_1
YST     xy       Close      Status_1

In above data Status_1 and Sysid defines unique record,Based on this condition i have to find out which records have open and close difference for that unique record combination. If options are different I have to copy that data to different sheet using excel macro.This should work only for id's US and CHN.Suppose if id has US ,it should compare with matching record based on sysid and Status. Any help appreciated.

Output Like below:

 XYZ      XT       Open       status_1
 US     XT       Close      Status_1
 CHN     XY       Open       Status_1
 YST     xy       Close      Status_1

解决方案

Edited to include test for "US" or "CHN"

Sub Tester()

Const COL_ID As Integer = 1
Const COL_SYSID As Integer = 2
Const COL_STATUS As Integer = 4
Const COL_OPTION As Integer = 3
Const VAL_DIFF As String = "XXdifferentXX"

Dim d As Object, sKey As String, id As String
Dim rw As Range, opt As String, rngData As Range
Dim rngCopy As Range, goodId As Boolean
Dim FirstPass As Boolean, arr

    With Sheet1.Range("A1")
        Set rngData = .CurrentRegion.Offset(1).Resize( _
                         .CurrentRegion.Rows.Count - 1)
    End With
    Set rngCopy = Sheet1.Range("F2")

    Set d = CreateObject("scripting.dictionary")
    FirstPass = True

redo:
    For Each rw In rngData.Rows

        sKey = rw.Cells(COL_SYSID).Value & "<>" & _
               rw.Cells(COL_STATUS).Value

        If FirstPass Then
          'Figure out which combinations have different option values
          '  and at least one record with id=US or CHN
          id = rw.Cells(COL_ID).Value
          goodId = (id = "US" Or id = "CHN")
          opt = rw.Cells(COL_OPTION).Value

          If d.exists(sKey) Then
              arr = d(sKey) 'can't modify the array in situ...
              If arr(0) <> opt Then arr(0) = VAL_DIFF
              If goodId Then arr(1) = True
              d(sKey) = arr 'return [modified] array
          Else
              d.Add sKey, Array(opt, goodId)
          End If

        Else
          'Second pass - copy only rows with varying options
          '  and id=US or CHN
          If d(sKey)(0) = VAL_DIFF And d(sKey)(1) = True Then
              rw.Copy rngCopy
              Set rngCopy = rngCopy.Offset(1, 0)
          End If
        End If

    Next rw
    If FirstPass Then
        FirstPass = False
        GoTo redo
    End If

End Sub

这篇关于Excel宏来比较行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！