使用偏移量在VBA中按给定顺序更改数据

时间:2022-07-22 21:23:51

I am trying to offset two columns of data to a row at a specific order, but I am not being able to set the offset function properly.

我试图以特定的顺序将两列数据偏移到一行,但是我不能正确地设置偏移函数。

I have something like:

我有类似:

ColumnA ColumnB
1   10
2   20
3   30
4   40
5   50

And I am trying to get 1 row, multiple columns, starting in a given ActiveCell that I may select (1 10 2 20 3 30 4 40 5 50)

我想要得到一行,多列,从给定的ActiveCell开始我可以选择(1 10 2 20 3 30 4 40 5 50)

My code so far is:

到目前为止,我的代码是:

Sub OffsetData1()
    Dim lRow As Long
    lRow = 0
    Do
        lRow = lRow + 1
        If IsEmpty(Cells(lRow, 2)) Then Exit Do
        Cells(lRow, 2).Copy
        ActiveCell.Offset(1, 1).PasteSpecial
    Loop
End Sub

Any help would be deeply appreciated.

任何帮助都将被深深感激。

2 个解决方案

#1


1  

Try the code below (explanations are inside the code comments)

尝试下面的代码(解释在代码注释中)

Option Explicit

Sub OffsetData1()

    Dim lRow As Long, Col As Integer
    Dim RowDest As Long, ColDest As Integer

    ' parameters for first cell Paste, these setting are for Cell A7
    RowDest = 7
    ColDest = 1

    For lRow = 1 To 5 ' loop through rows
        For Col = 1 To 2 ' loop through columns
            ' only copy cells with values inside
            If Cells(lRow, Col) <> "" Then
                Cells(RowDest, ColDest) = Cells(lRow, Col)
                ColDest = ColDest + 1
            End If
        Next Col
    Next lRow

End Sub

#2


0  

you can exploit the "natural" enumeration of a range:

您可以利用范围的“自然”枚举:

Option Explicit

Sub main2()
    Dim cell As Range
    Dim iCol As Long

    For Each cell In Range("B1", Cells(Rows.Count, "A").End(xlUp))
        iCol = iCol + 1
        Cells(7, iCol) = cell.Value
    Next    
End Sub

#1


1  

Try the code below (explanations are inside the code comments)

尝试下面的代码(解释在代码注释中)

Option Explicit

Sub OffsetData1()

    Dim lRow As Long, Col As Integer
    Dim RowDest As Long, ColDest As Integer

    ' parameters for first cell Paste, these setting are for Cell A7
    RowDest = 7
    ColDest = 1

    For lRow = 1 To 5 ' loop through rows
        For Col = 1 To 2 ' loop through columns
            ' only copy cells with values inside
            If Cells(lRow, Col) <> "" Then
                Cells(RowDest, ColDest) = Cells(lRow, Col)
                ColDest = ColDest + 1
            End If
        Next Col
    Next lRow

End Sub

#2


0  

you can exploit the "natural" enumeration of a range:

您可以利用范围的“自然”枚举:

Option Explicit

Sub main2()
    Dim cell As Range
    Dim iCol As Long

    For Each cell In Range("B1", Cells(Rows.Count, "A").End(xlUp))
        iCol = iCol + 1
        Cells(7, iCol) = cell.Value
    Next    
End Sub