使用循环将列中的数据复制到新列中

时间:2017-09-12 15:50:19

标签: excel vba

Rows  | Ref1    |   Ref2  | Ref3|   Final Ref    
3     |   aa    |    bb   | cc  |   aa    
3     |   aa    |    bb   | cc  |   bb    
3     |   aa    |    bb   | cc  |   cc    
2     |   as    |    al   |     |   as    
2     |   as    |    al   |     |   al

下面的vba自动创建了最终参考资料。柱。此值取自其他列。例如。有3个重复的行,具有相同的引用;我需要第一行的Ref1,第二行的Ref2和第三行的Ref3。然后对于接下来的两行(重复),我需要第一行的Ref1和第二行的Ref2等。

这是我到目前为止所拥有的。基于最长的行,我希望该范围是动态的。我现在必须输入一个值。我有vba单独选择使用范围,但我不知道如何将两者结合起来。提前谢谢。

Sub CopyRowPasteRef()
Dim rngToConvert As Range
Dim rngRow As Range
Dim rngCell As Range

'incremental step to keep track of rows
Dim writeRow As Integer
writeRow = 1

'The entire range we are converting
Set rngToConvert = Sheets("Sheet11").Range("A1:E6")

'Loop through each row
For Each rngRow In rngToConvert.Rows

    'Loop through each cell (field)
    For Each rngCell In rngRow.Cells

        'ignore that first row
        If rngCell.Column > 1 And rngCell.Value <> "" Then

            'Write that row header
            Sheets("Sheet12").Cells(writeRow, 1).Value = rngRow.Cells(1, 1)

            'Write this non-null value
            Sheets("Sheet12").Cells(writeRow, 2).Value = rngCell.Value

            'Increment Counter
            writeRow = writeRow + 1
        End If
    Next rngCell
Next rngRow
End Sub

如何将下面的vba添加到上面的vba中,以根据使用的单元格合并动态范围?

Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
  SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
  Cells.Find(What:="*", SearchOrder:=xlByColumns, _
  SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select

1 个答案:

答案 0 :(得分:1)

将其放入E2并复制下来:

=INDEX(B2:D2,COUNTIFS($B$1:B2,"=" &B2,$C$1:C2,"=" & C2,$D$1:D2,"=" &D2))

enter image description here