Question

我在进行对帐时遇到问题，我的某些资产孩子与父母的使用状况，所有权等不匹配。我需要将所有父母拉到一张新纸上，以手动验证所有数据是否正确。这是我问题的第一部分。

上面显示的示例。

在行4997中，两个EQ编号匹配。这是父行。我需要将B和C列中具有匹配EQ编号的所有行复制到单独的工作表中。然后，我将手动对其进行编辑，以使所有其他列均与我们的实际书籍一样准确。

那是我的第一个问题。

除此之外，还有一个单独的问题。

然后，我需要在单独的工作表中获取所有已更改的信息，并用新的父信息替换原始工作表中的旧父信息。从那里，我需要让所有孩子都反映相同的信息。如您在示例中看到的，第4997行的父级显示为已租用，但其下的所有子级均显示为可用。我需要所有子级的E，F，G，H，I和J列，以反映与父级相同的信息。

在C列中，所有子代都与父代反映相同的EQ号。Ep0005212。

这是一个很大的列表，有1000多个父母。

我发现了与我想做的事情类似的事情，但它与我的需求完全不符。

Option Explicit

Sub Test()

Dim rngCell As Range
Dim lngLstRow As Long
Dim keywords() As String
Dim maxKeywords, i, j, k As Integer


maxKeywords = 6
ReDim keywords(1 To maxKeywords)

keywords(1) = "_LC"
keywords(2) = "_LR"
keywords(3) = "_LF"
keywords(4) = "_W"
keywords(5) = "_R"
keywords(6) = "_RW"

lngLstRow = ActiveSheet.UsedRange.Rows.Count

For j = 1 To lngLstRow
  For i = 1 To maxKeywords
    If keywords(i) = Right(Sheets("Results").Range("L" & j).Value,     
Len(keywords(i))) Or _
      keywords(i) = Right(Sheets("Results").Range("M" & j).Value, 
Len(keywords(i))) Then
        k = k + 1
          Rows(j & ":" & j).Copy
            Sheets("sheet1").Select
              Range("A" & k).Select
                ActiveSheet.Paste
    End If
  Next i
Next j

End Sub

在解决第一个问题方面的任何帮助将不胜感激，但是，如果您能找到第二个问题的解决方案，我将永远为您效劳。

Answer 1

好吧，我已经解决了您的第一个问题，直到明天我才能解决第二个问题，如果那时没有人解决，我有个主意。 编辑：请参见下面的编辑，我保证会回来的：）

Sub findParent()
    Dim masterWs As New Worksheet
    Dim masterEndRc As Long
    Set masterWs = Sheets("Sheet1")

    Dim parentWs As New Worksheet
    Set parentWs = Sheets("Sheet2")

    Dim masterCounter As Long
    Dim parentCounter As Long
    parentCounter = 1
    masterCounter = 1
    Dim colBStr As String 'set up temp variables, you could compare values directly
    Dim colCstr As String 'but call me crazy, i think that this way is more accurate

    masterEndRc = masterWs.UsedRange.Rows.Count

    Do
        colBStr = masterWs.Cells(masterCounter, "B").Value 'Load the value into the temp variables
        colCstr = masterWs.Cells(masterCounter, "C").Value

        If colBStr = colCstr Then
            masterWs.Cells(masterCounter, "B").EntireRow.Cut parentWs.Cells(parentCounter, "A")
            parentWs.Cells(parentCounter, "E").Value = masterCounter 'Make this the first empty column, this is so that we can find its original row
            'for reinsert later
            parentCounter = parentCounter + 1
        End If
        masterCounter = masterCounter + 1
    Loop While masterCounter <= masterEndRc
End Sub

编辑

确定第二个问题已解决:)确保更改任何变量以匹配工作表，例如列和工作表名称。在上面的宏下运行第一个子，然后在下面的第二个运行。

Sub restoreParent()
    Dim masterWs As New Worksheet
    Dim masterEndRc As Long
    Set masterWs = Sheets("Sheet1")

    Dim parentWs As New Worksheet
    Set parentWs = Sheets("Sheet2")
    Dim parentEndRc As Long
    Dim parentCounter As Long
    Dim oldRowLong As Long
    Dim rowColl As New Collection 'for storing of the parent row numbers for use while changing child rows later
    parentEndRc = parentWs.UsedRange.Rows.Count
    parentCounter = 1

    Do
        oldRowLong = parentWs.Cells(parentCounter, "E").Value
        rowColl.Add oldRowLong
        parentWs.Cells(parentCounter, "B").EntireRow.Cut masterWs.Cells(oldRowLong, "A")
        parentCounter = parentCounter + 1
    Loop While parentCounter <= parentEndRc

    changeChildRows rowColl, masterWs
End Sub

Function changeChildRows(rowColl As Collection, masterWs As Worksheet)
    Dim nextChildRow As Long
    Dim childRowCounter As Long
    Dim parentRow As Variant
    Dim firstChild As Boolean
    firstChild = True

    For Each parentRow In rowColl
        childRowCounter = parentRow
        Do
            If firstChild = True Then
                nextChildRow = parentRow + 1
                If masterWs.Cells(parentRow, "C").Value = masterWs.Cells(nextChildRow, "C") Then
                    masterWs.Cells(nextChildRow, "D").Value = masterWs.Cells(parentRow, "D").Value 'Make sure to change these column values to match yours
                End If
                firstChild = False
            ElseIf firstChild = False Then
                nextChildRow = nextChildRow + 1
                If masterWs.Cells(parentRow, "C").Value = masterWs.Cells(nextChildRow, "C") Then
                    masterWs.Cells(nextChildRow, "D").Value = masterWs.Cells(parentRow, "D").Value 'Make sure to change these column values to match yours
                End If
            End If
        childRowCounter = childRowCounter + 1
        Loop Until masterWs.Cells(childRowCounter, "C").Value <> masterWs.Cells(parentRow, "C").Value
        firstChild = True
    Next parentRow
End Function

Answer 2

如果您不重复此操作，建议您使用VBA。

只需添加带有公式的列：= IF（B1 = C1; 1; 0）（将其拖动）或更简单的= B1 = C1。如果它们匹配，您将拥有1（否则为0），然后您可以过滤所有父项并复制到新的工作表/文件中。

在编辑了父项之后，在表中的E，F，G，H，I和J列中仅放置了INDEX MATCH公式（或更糟的是VLookup）（当然，将其拖动）。您应该将C列与该已编辑表格中的父母编号进行比较（如果使用INDEX MATCH，则可以选择B或C，因为它们相同），所以VLookup不太方便。有很多不错的教程，介绍如何使用这些功能。

如果您真的想要vba，则可以基本上记录下来并进行一些修改。

VBA Excel-根据两列具有匹配数据的行进行复制

2 个答案: