在 Excel 中循环行以将计数器分配给不同的行

Question

我有一个表，其中的值从左到右在行中递增，然后一旦进一步向下，就会再次更改。

我想循环遍历各行，并将这些行中的值设置在不同的工作表中，以进入第 2 行的 A 列，然后从 A2 --> A3 --> A4...等递增。

Sub LoopthroughRows ()
LastRow = Range("O" & Rows.Count).End(xlUp).Row
FirstRow = 2
i = FirstRow
FirstColumn = 15
Do Until i > LastRow
    LastColumn = Cells(i, Columns.Count).End(xlToLeft).Column
    Count = FirstColumn
    k = 2
    Do Until Count > LastColumn
        Set Worksheets(Sheet7).Range("A" & k).Value = Worksheets(Sheet5).Range(Chr(Count + 64) & i).Value
        Count = Count + 1
    Loop
    k=k+1
    i=i+1
Loop
End Sub

我明白了

运行时错误“13”类型不匹配。

我测试了运行行功能并且它有效。

Answer 1

从范围获取列

快速修复：练习

Do

循环（慢速）

Sub LoopthroughRows()
    
    Dim fCell As Range: Set fCell = Sheet5.Range("O2")
    
    Dim FirstRow As Long: FirstRow = fCell.Row
    Dim FirstColumn As Long: FirstColumn = fCell.Column
    
    Dim LastRow As Long
    LastRow = Sheet5.Cells(Sheet5.Rows.Count, FirstColumn).End(xlUp).Row
    
    Dim sr As Long: sr = FirstRow
    Dim dr As Long: dr = 2
    
    Dim LastColumn As Long
    Dim sc As Long
    
    Do Until sr > LastRow
        sc = FirstColumn
        LastColumn = Sheet5.Cells(sr, Sheet5.Columns.Count).End(xlToLeft).Column
        Do Until sc > LastColumn
            Sheet7.Cells(dr, "A").Value = Sheet5.Cells(sr, sc).Value
            sc = sc + 1
            dr = dr + 1
        Loop
        sr = sr + 1
    Loop

End Sub

改进：使用函数（快速）

Sub GetColumnFromRangeTEST()

    Dim sfCell As Range: Set sfCell = Sheet5.Range("O2")
    Dim srg As Range
    With sfCell.CurrentRegion
        Set srg = sfCell.Resize(.Row + .Rows.Count - sfCell.Row, _
            .Column + .Columns.Count - sfCell.Column)
    End With

    Dim Data() As Variant
    ' Read by rows:
    Data = GetColumnFromRange(srg)
    ' Read by columns:
    'Data = GetColumnFromRange(srg, True)
    
    Dim dfCell As Range: Set dfCell = Sheet7.Range("A2")
    Dim drg As Range: Set drg = dfCell.Resize(UBound(Data, 1))
    
    drg.Value = Data

End Sub


Function GetColumnFromRange( _
    ByVal rg As Range, _
    Optional ByVal ReadByColumns As Boolean = False) _
As Variant()
    
    Dim srCount As Long: srCount = rg.Rows.Count
    Dim scCount As Long: scCount = rg.Columns.Count
    Dim drCount As Long: drCount = srCount * scCount
    
    Dim sData() As Variant
    If drCount = 1 Then
        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = rg.Value
    Else
        sData = rg.Value
    End If
    
    Dim dData() As Variant: ReDim dData(1 To drCount, 1 To 1)
    Dim sr As Long, sc As Long, dr As Long
    
    If ReadByColumns Then
        For sc = 1 To scCount
            For sr = 1 To srCount
                dr = dr + 1
                dData(dr, 1) = sData(sr, sc)
            Next sr
        Next sc
    Else
        For sr = 1 To srCount
            For sc = 1 To scCount
                dr = dr + 1
                dData(dr, 1) = sData(sr, sc)
            Next sc
        Next sr
    End If
    
    GetColumnFromRange = dData

End Function

Answer 2

如果这只是行/列的交换，您可以在不循环的情况下执行此操作：

Sub test()
    With Sheets(1)
        Dim sourceRng As Range:  Set sourceRng = .Range(.Cells(1, 1), .Cells(4, 2))
        .Cells(6, 6).Resize(sourceRng.Columns.Count, sourceRng.Rows.Count).Value = Application.Transpose(sourceRng)
    End With
End Sub

请注意，我在“行”位置使用

sourceRng.Columns.Count

，在“列”位置使用

sourceRng.Rows.Count

来调整大小。

---

编辑1：

修改以指示如何用作循环（未经测试）：

Sub test()
    With Sheets(1)
        Dim i as Long
        For i = firstRowSource to lastRowSource
            Dim sourceRng As Range:  Set sourceRng = .Range(.Cells(i, 1), .Cells(i, 2))
            Dim targetColDest as Long:  targetColDest = targetColDest + 1
            .Cells(1, targetColDest ).Resize(sourceRng.Columns.Count,).Value = Application.Transpose(sourceRng)
        Next i
    End With
End Sub

Answer 3

此代码将行转换为一长列（值从 0 到 319）

Sub LoopthroughRows()
    With ThisWorkbook
        a = .Sheets(1).Range("O2").CurrentRegion
        ReDim b(UBound(a, 1) * UBound(a, 2))
        i = 0
        For r = 1 To UBound(a, 1)
            For c = 1 To UBound(a, 2)
                b(i) = a(r, c)
                i = i + 1
            Next
        Next
        .Sheets(2).Range("A2").Resize(UBound(b)) = WorksheetFunction.Transpose(b)
    End With
End Sub