公式无法使用VB正确复制 - 完整代码

时间:2013-02-06 09:26:13

标签: excel excel-vba vba

两位“Peter's”以前帮我解决了这个问题,但我无法在评论中添加完整的代码。

问题是:当我在下面的代码中添加“.FormulaR1C1”时,我收到一条错误消息“需要对象”。它没有“.FormulaR1C1但在实际公式中产生问题。”

守则

表格(gcsCombinedSheetName)。细胞(lngLastRow,columnletter).FormulaR1C1 = getConfigPosition.Offset(0,2).Formula.R1C1

完整代码

Sub Pricing_format()

Dim lngLastRow As Long
Dim lngLastRow2 As Long
Dim Fundcolumn As Long
Dim rngToCheck As Range
Dim columnletter As String
Dim columnheader As String
Dim ActuateColumn As Long
Dim getConfigPosition As Range
Dim counter As Long
Dim getFormula As Variant
Dim Wk As Worksheet
Dim WB As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic

Set gRwksconfigeration = Sheets(gcsConfigSheetName)
gRnCT_FieldSearch_Brks = gRwksconfigeration.Range(CT_FieldSearch_Brks)
gRnCT_Fieldsearch_SecurID = gRwksconfigeration.Range(CT_FieldSearch_SecurID)
gRnCT_FieldSearch_BrokerFactor = gRwksconfigeration.Range(CT_FieldSearch_BrokerFactor)
gRnCT_Required_Col = gRwksconfigeration.Range(CT_Required_Col)
gRnCT_File_Loc = gRwksconfigeration.Range(CT_File_Loc)
gsInputFileName = Dir(gRnCT_File_Loc)

counter = 1

Set gwkscurrent = ActiveWorkbook

    With Sheets(gcsCombinedSheetName)
        .Cells.Clear
    End With

    Do

        lngLastRow2 = FindLastRow(gwkscurrent.Sheets(gcsCombinedSheetName).Name)

        'On Error GoTo OpenError
            Set gwkbInputdata = Workbooks.Open(gRnCT_File_Loc & gsInputFileName)
        'On Error GoTo 0

        With Sheets(1)

            Fundcolumn = Sheets(1).Cells.Find(What:=gRnCT_Fieldsearch_SecurID, after:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, searchorder:=xlByColumns).Column
            lngLastRow = FindLastRow(Sheets(1).Name)

                If Application.WorksheetFunction.CountA(.Cells) > 0 Then

                    Set rngToCheck = Range(.Cells(1, Fundcolumn), .Cells(lngLastRow, Fundcolumn))

                    If rngToCheck.Count > 1 Then

                            On Error Resume Next
                            rngToCheck.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                            On Error GoTo 0
                        Else
                            If VBA.IsEmpty(rngToCheck) Then rngToCheck.EntireRow.Delete
                    End If

                End If

                On Error Resume Next
                    .Cells.Find(What:=gRnCT_FieldSearch_Brks, after:=ActiveCell, LookIn:=xlValues _
                        , LookAt:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext).EntireColumn.Delete Shift:=xlToLeft
                On Error GoTo 0

                On Error Resume Next
                    .Cells.Find(What:=gRnCT_FieldSearch_BrokerFactor, after:=ActiveCell, LookIn:=xlValues _
                        , LookAt:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext).EntireColumn.Delete Shift:=xlToLeft
                On Error GoTo 0

             lngLastRow = FindLastRow(Sheets(1).Name)

            Range(.Cells(1, 1), .Cells(lngLastRow, 1)).EntireRow.Copy gwkscurrent.Sheets(gcsCombinedSheetName).Cells(lngLastRow2 + 1, 1)

            ActiveWorkbook.Close False

        End With

        gsInputFileName = Dir

    Loop Until gsInputFileName = vbNullString



    Set getConfigPosition = Sheets(gcsConfigSheetName).Cells.Find(What:=gRnCT_Required_Col, after:=ActiveCell, LookIn:= _
            xlValues, LookAt:=xlWhole, searchorder:=xlByColumns, searchdirection:= _
            xlNext, MatchCase:=False, SearchFormat:=False).Offset(counter, 0)

    Do

        columnletter = getConfigPosition
        columnheader = getConfigPosition.Offset(0, 1)
        getFormula = getConfigPosition.Offset(0, 2)


            lngLastRow = FindLastRow(gcsCombinedSheetName)

            Sheets(gcsCombinedSheetName).Cells(lngLastRow, columnletter).FormulaR1C1 = getConfigPosition.Offset(0, 2).Formula.R1C1
            Sheets(gcsCombinedSheetName).Cells(2, columnletter) = getConfigPosition.Offset(0, 1)

            With Sheets(gcsCombinedSheetName)
               .Cells(lngLastRow, columnletter).Copy Range(.Cells(lngLastRow, columnletter), .Cells(3, columnletter))
            End With

            counter = counter + 1

            Set getConfigPosition = Sheets(gcsConfigSheetName).Cells.Find(What:=gRnCT_Required_Col, after:=ActiveCell, LookIn:= _
                    xlValues, LookAt:=xlWhole, searchorder:=xlByColumns, searchdirection:= _
                    xlNext, MatchCase:=False, SearchFormat:=False).Offset(counter, 0)


    Loop Until getConfigPosition = ""

    With Sheets(gcsCombinedSheetName).Rows("2:2")
                    .Font.Bold = True
                    .EntireColumn.AutoFit
    End With

    MsgBox ("Macro Complete")

End Sub

2 个答案:

答案 0 :(得分:1)

很少有评论:

  • 要解决您的问题,请将Formula.R1C1替换为FormulaR1C1
  • 你的缩进很奇怪。例如,不需要在行lngLastRow = FindLastRow(gcsCombinedSheetName)中缩进。通常只有在存在“子代码块”时才缩进,例如在For循环,If语句等
  • 仅在访问对象的多个属性时才使用With
    With Sheets(gcsCombinedSheetName)
        .Cells.Clear
    End With
    可以替换为Sheets(gcsCombinedSheetName).Cells.Clear
  • 考虑使用Range.Resize代替Range(Cell1, Cell2)) - 通常前者更容易

最后但并非最不重要:您可以在SO中编辑问题,因此无需打开新的问题! : - )

答案 1 :(得分:0)

我明白了。当我在公式中使用RC []引用并且只使用“.formula”而不是“.formulaR1C1”时它可以工作。这违背了我理解的逻辑,但它起作用了。我要感谢“Peter A”& “彼得L”继续支持他们。谢谢小伙子们。