Question

我一直在尝试整理我的数据，以便将所有相似的数据（在几列中找到）都可以复制到一个列中。这是到目前为止我编写的脚本的简化版本（范围包括更多的列，但是出于视觉原因，在此我将其简化了）。我不确定如何告诉我要在此复制所选单元格所在的行。我希望我已经足够清楚了。

Dim value As String
Dim rngTemp1 As Range
Dim rngTemp2 As Range
Dim rngTemp3 As Range
Dim rngTemp4 As Range
Dim rngTemp5 As Range

With Workbooks("ExploringTheRelation.xlsx").Sheets("ExploringTheRelation")
Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rngTemp1 = .Range("W2:W" & Lastrow & ", AB2:AB" & Lastrow)
Set rngTemp2 = .Range("X2:X" & Lastrow & ", AC2:AC" & Lastrow)


For Each cell In rngTemp1
cell.Copy
cell(18, **Row**).Paste
Next cell

For Each cell In rngTemp2
cell.Copy
cell(18, **Row**).Paste
Next cell

End With

谢谢您的帮助

Answer 1

如果我没看错，您正在尝试将跨列的数据合并为一列？如果是这样，请根据需要进行调整：

Dim rowStart    as long
Dim cell        as variant
Dim rngTemp1    as excel.range

rowStart = 2
With ActiveSheet
    For Each cell In rngTemp1
        If Len(cell.Value) > 0 Then
            .Cells(rowStart, 6).Value = cell.Value
            rowStart = rowStart + 1
        End if
    Next cell
End With

Answer 2

这就是我要做的。只需添加另一个变量来计算添加值的上一行。

With Workbooks("ExploringTheRelation.xlsx").Sheets("ExploringTheRelation")

    'finds the bottom row of data
    Dim lastRow As Long
    lastRow = .Cells(Rows.count, 1).End(xlUp).row

    Dim rngTemp1 As Range
    Set rngTemp1 = .Range("W2:W" & lastRow & ", AB2:AB" & lastRow)

    Dim rngTemp2 As Range
    Set rngTemp2 = .Range("X2:X" & lastRow & ", AC2:AC" & lastRow)

    'keeps track of the last row that a value was put into
    Dim currRow As Long
    currRow = 1

    'loops through a range and puts each value into column "R" one after another
    Dim cel As Range
    For Each cel In rngTemp1
        .Cells(currRow, "R").Value2 = cel.Value2
        currRow = currRow + 1
    Next cell

    For Each cel In rngTemp2
        .Cells(currRow, "R").Value2 = cel.Value2
        currRow = currRow + 1
    Next cell

End With

将单元格从选定的列范围复制到特定列，同时保留同一行

2 个答案: