【问题标题】:Excel VBA - Creating New Spreadsheet With Only New Information and Changes HighlightedExcel VBA - 创建仅突出显示新信息和更改的新电子表格
【发布时间】:2015-07-02 21:42:10
【问题描述】:

我的目标:我需要能够从不同的工作簿中取出两个不同的工作表,并将它们组合成一个带有两个工作表的工作簿(已经完成)。其中一个工作表将来自旧数据并用作主列表,而另一个工作表将包含旧数据以及新数据(以及对旧数据的更改)。我需要能够摆脱主列表中已经存在的旧数据,但仍然检查旧数据是否有任何变化(这些信息将从新信息工作表中删除)。最终目标是有两个工作表:1 个包含旧信息(已经完成),1 个包含新信息和对新信息的任何更改(需要帮助)。

我现在拥有的:

子 DocumentInspector()

Dim RowCount As Integer
Dim Row As Integer
Dim Column As Integer
Dim ColumnCount As Integer
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim i As Integer
Dim count As Integer
Dim count2 As Integer

count2 = 0
i = 0
count = 0

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

MyPath = "F:\ \Document Inspector" ' change to suit

Set wbDst = Workbooks("DocumentInspector.xlsm")
strFilename = Dir(MyPath & "\*.xlsx", vbNormal)
If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""
        Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
        Set wsSrc = wbSrc.Worksheets(1)
        wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.count)
        strFilename = Dir()
Loop

wbDst.Worksheets(2).Name = "Old Information"
wbDst.Worksheets(3).Name = "New Information"

'MUST CHANGE RANGES
RowCount = Sheets("New Information").UsedRange.Rows.count
ColumnCount = Sheets("New Information").UsedRange.Columns.count
'MUST CHANGE RANGE
For Each x In Sheets("Old Information").Range("A1:E10")

    For Row = 2 To RowCount
        For Column = 1 To ColumnCount
            If x.Value = Sheets("New Information").Cells(Row, Column).Value Then
                    Sheets("New Information").Cells(Row, Column).Interior.Color = RGB(255, 255, 0)
            End If
        Next Column
    Next Row
Next

For Row = 2 To RowCount
    For Column = 1 To ColumnCount

        If Sheets("New Information").Cells(Row, Column).Interior.Color = RGB(255, 255, 0) Then
            Sheets("New Information").Cells(Row, Column).Interior.Color = xlNone
            count = count + 1
        Else
            Sheets("New Information").Cells(Row, Column).Interior.Color = RGB(255, 255, 0)
            count2 = count2 + 1
        End If
     Next Column

    If count = ColumnCount Then
        Sheets("New Information").Rows(Row).EntireRow.Interior.Color = xlNone
        Sheets("New Information").Rows(Row).EntireRow.Delete
        Row = Row - 1
    ElseIf count2 = ColumnCount Then
        Sheets("New Information").Rows(Row).EntireRow.Interior.Color = xlNone
        Sheets("New Information").Rows(Row).EntireRow.Delete
    End If
    count2 = 0
    count = 0
Next Row


Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

结束子

【问题讨论】:

    标签: vba excel


    【解决方案1】:

    试试这个,
    我已经完成了公式,你也可以在 VBA 中动态地做同样的事情。

    这可以是一种解决方案,但可能有比这更好的解决方案。

    参考下图。

    这是简单的匹配和连接。

    【讨论】:

    • 如果两个工作表上的行应该相同,这将正常工作,但行会有所不同。这些行可以位于工作表上的任何位置,如果它们是旧的,我需要能够删除它们并突出显示新信息。
    • 如果数据在工作表中的任何位置,您都可以这样做,并且您需要过滤并保留所需的内容。
    【解决方案2】:

    我需要做的事情的例子:

    工作表 1“旧信息”

    A B C D

    E F G H

    工作表 2“新信息”

    A B C D

    E F J H

    运行代码....

    工作表 1“旧信息”

    A B C D

    E F G H

    工作表 2“新信息”

    E F J H(J 突出显示)

    【讨论】:

      猜你喜欢
      • 2019-03-06
      • 1970-01-01
      • 2017-06-01
      • 1970-01-01
      • 1970-01-01
      • 2013-04-21
      • 1970-01-01
      • 1970-01-01
      • 2022-08-22
      相关资源
      最近更新 更多