Question

注意：我试图在Mac上执行此操作。

我有多个工作簿，其中有以发票格式列出的发票信息，我需要提取其中的各种数据，并编译一个可以导入到另一个软件中的工作表。

这是我编写的代码：

Sub GetFile()

Dim fNameAndPath As Variant
Dim wbdata As Workbook
Dim wbsource As Workbook
Dim ShToCopy As Worksheet
Dim rangedata As Range

'set data workbook
Set wbdata = ThisWorkbook
Set rangedata = ActiveCell

'open other workbook and set as source workbook

fNameAndPath = Application.GetOpenFilename
If fNameAndPath = False Then Exit Sub
Set wbsource = Workbooks.Open(fNameAndPath)
Set ShToCopy = wbsource.Worksheets("PCO #")


Call Extract_Invoice_Data_1(wbdata, wbsource, ShToCopy, rangedata)
Call Extract_Invoice_Data_2(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_3(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_4(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_5(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_6(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_7(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_8(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_9(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_10(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_11(wbdata, wbsource, ShToCopy)


wbsource.Close SaveChanges:=False
Set wbsource = Nothing

End Sub

Sub Extract_Invoice_Data_1(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet, rangedata As Range)

    rangedata.Value = ShToCopy.Range("G5").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_2(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G4").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_3(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C3").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_4(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C4").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_5(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C5").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_6(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C6").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_7(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G32").Value
    ActiveCell.Offset(0, 1).Activate

End Sub


Sub Extract_Invoice_Data_8(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G25").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_9(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G28").Value
    ActiveCell.Offset(0, 1).Activate
    ActiveCell = "=RC[-1]*0.15"
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_10(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G21").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_11(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G22").Value
    ActiveCell.Offset(0, 1).Activate
    ActiveCell = "=RC[-1]*0.15"
    ActiveCell.Offset(0, 1).Activate
    ActiveCell = "=SUM(RC[-4]:RC[-1])"
    ActiveCell.Offset(0, 1).Activate

End Sub

问题在于，它只会在数据工作表的第一个单元格中输入数据，而不会提取其他任何数据。请帮忙！

Answer 1

未经测试，但是您看到了如何在不使用ActiveCell / Activate等的情况下如何工作：

Sub ChooseInputFileAndExtractData()

    Dim fNameAndPath As Variant
    Dim wbsource As Workbook
    Dim destRow As Range

    Set destRow = ActiveCell.EntireRow  'get the selected Row

    'open other workbook and set as source workbook
    fNameAndPath = Application.GetOpenFilename
    If fNameAndPath <> False Then
        Set wbsource = Workbooks.Open(fNameAndPath)

        ExtractInvoiceData destRow, wbsource.Worksheets("PCO #")

        wbsource.Close SaveChanges:=False
        Set wbsource = Nothing
    End If

End Sub

Sub ExtractInvoiceData(destRow As Range, SourceSheet As Worksheet)
    With destRow
        .Cells(1).Value = SourceSheet.Range("G5").Value
        .Cells(2).Value = SourceSheet.Range("G4").Value
        .Cells(3).Value = SourceSheet.Range("C3").Value
        .Cells(4).Value = SourceSheet.Range("C4").Value
        .Cells(5).Value = SourceSheet.Range("C5").Value
        .Cells(6).Value = SourceSheet.Range("C6").Value
        .Cells(7).Value = SourceSheet.Range("G32").Value
        .Cells(8).Value = SourceSheet.Range("G25").Value
        .Cells(9).Value = SourceSheet.Range("G28").Value
        .Cells(10).FormulaR1C1 = "=RC[-1]*0.15" '
        'etc etc you get the idea
    End With
End Sub

Mac版VBA Excel-无法更改ActiveCell

1 个答案: