両方の「Peter's」が以前にこれを手伝ってくれましたが、コメントに完全なコードを追加できませんでした。
問題: ".FormulaR1C1 を以下のコードに追加すると、"オブジェクトが必要です" というエラー メッセージが表示されます。".FormulaR1C1 がなくても機能しますが、実際の数式に問題が生じます。
コード
Sheets(gcsCombinedSheetName).Cells(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")
サブ終了