比较和移动excel中的字段

时间:2013-09-23 20:28:15

标签: excel compare excel-formula

我有一个奇怪的问题,我希望有人可以帮助我。我在A列中有一个项目列表,并在D列中有另一个项目列表。这些项目大致相同,B列中只有几个项目。

Column A     Column B    Column C          Column D
1015          1015          $25               $5
1025          1035          $25               $5
1035          1045          $25               $5
1045          1055          $25               $5

好的,我想做的是使用A列中的项目,然后比较B列。

然后我想从B-D向下移动行,这样D就在A旁边并具有相同的skus。

Column A     Column B    Column C          Column D
1015          1015          $25               $5
1025          
1035          1035          $25               $5
1045          1045          $25               $5

请帮忙!非常感谢!!!

2 个答案:

答案 0 :(得分:0)

假设B列中没有不匹配的值。

对于VBA解决方案,请尝试以下方法:

Sub MatchRows()
  Dim sheet As Worksheet
  Set sheet = ActiveWorkbook.Sheets("Sheet1")

  'First Column
  Dim rngA As Range
  Set rngA = [A1:A10]
  Dim datA As Variant
  datA = rngA
  Dim i As Long

  'Second Column Match
  Dim rngB As Range
  Set rngB = [B1:B10]
  Dim datB As Variant
  datB = rngB
  Dim j As Long

  'Store duplicates
  Dim rngString As String

  'First Column loop
  For i = LBound(datA, 1) To UBound(datA, 1)
    'Second Column Loop
    For j = LBound(datB, 1) To UBound(datB, 1)
        'Check if duplicate
        If datA(i, 1) = datB(j, 1) And i <> j And Not IsEmpty(datB(j, 1)) And Not IsEmpty(datA(i, 1)) Then
            Dim rng As String
            rng = Chr(rngB.Column + 64) & j & ":" & Chr(rngB.Column + 64 + 2) & j
            Range(rng).Select

            For k = 1 To (i - j)
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Next
        End If
      Next
  Next
End Sub

请注意,我对要下推的列数的范围和偏移值(+2)进行了硬编码。

答案 1 :(得分:0)

假设您的输入在Sheet1上。然后将新工作表中的以下公式复制到单元格

A1: =Sheet1!A1
B1: =IFERROR(VLOOKUP(A1;Sheet1!$B$1:$D$4;1;FALSE);"")
C1: =IFERROR(VLOOKUP(A1;Sheet1!$B$1:$D$4;2;FALSE);"")
D1: =IFERROR(VLOOKUP(A1;Sheet1!$B$1:$D$4;3;FALSE);"")

然后将第一行复制到第2,3和4行。