使用 VBA 宏从 excel 中的 sheet 中提取数据

Question

这是我刚刚写出来的宏，不幸的是它似乎没有做任何事情，我找不到错误！我正在尝试将带有 header "Offset Acct" 的列从 sheet 1 (SAPDump) 复制到 sheet 2 (Extract)，这是空白的。谁能看到向我解释为什么这不起作用？ VBA 相当新，所以它可能很容易修复。干杯

Sub ExtractData()

' Define sheets

Dim SAPDump As Worksheet
Dim Extract As Worksheet

' Set sheets

Set SAPDump = ActiveSheet
Set Extract = ThisWorkbook.Sheets("Extract")

' Define row and column counters

Dim r As Long
Dim c As Long

' Set last non-empty column

Dim lastCol As Long
lastCol = SAPDump.Cells(1, Columns.Count).End(xlToLeft).Column

' Set last non-empty row

Dim lastRow As Long
lastRow = SAPDump.Cells(Rows.Count, "A").End(xlUp).row

' Look a all columns
For c = 1 To c = lastCol
    ' Examine top column
    If SAPDump.Cells(1, c).Value = "Offset Acct" Then
        ' Loop round all rows
        For r = 1 To r = lastRow
            ' Copy column into A on Extract
            Extract.Cells(r, 1) = SAPDump.Cells(r, c)
        Next r
    Else

    End If

Next c

End Sub

Answer 1

您需要更改这些行：

For c = 1 To c = lastCol

    to

For c = 1 To lastCol

和

For r = 1 To r = lastRow

to

For r = 1 To lastRow

编辑：

更好的方法可能是这样做：

Sub ExtractData()

    ' Define sheets
    Dim SAPDump As Worksheet
    Dim Extract As Worksheet

    'Define Heading range
    Dim rHeadings As Range
    Dim rCell As Range

    ' Set sheets
    Set SAPDump = ActiveSheet
    Set Extract = ThisWorkbook.Sheets("Extract")

    'Set Heading range.
    With SAPDump
        Set rHeadings = .Range(.Cells(1, 1), .Cells(1, Columns.Count).End(xlToLeft))
    End With

    'Look at each heading.
    For Each rCell In rHeadings
        If rCell.Value = "Offset Acct" Then
            'If found copy the entire column and exit the loop.
            rCell.EntireColumn.Copy Extract.Cells(1, 1)
            Exit For
        End If
    Next rCell

End Sub

Answer 2

设置不确定，如何在excel宏中运行相同。

请您通过 .pdf 格式发送。

此致

斯大林。

使用 VBA 宏从 excel 中的 sheet 中提取数据

Extracting data from a sheet in excel using VBA Macro

excel

vba

extract