使用VBAmacros从Excel表格中提取数据

这里是我刚刚写出来的macros，不幸的是，它似乎没有做任何事情，我找不到错误！ 我试图从表1（SAPDump）复制到标题为“Offset Acct”的表格到表单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

该设置是不确定的，如何在Excelmacros中运行相同。

请求您通过.pdf同伴发送相同的内容。

问候

斯大林。