Excel VBA Set TargetCell = диапазон с динамическими параметрами, основанными на значении ячейки - PullRequest
Новая
       38

Excel VBA Set TargetCell = диапазон с динамическими параметрами, основанными на значении ячейки

1 голос
/ 07 июня 2019

Я пытаюсь скопировать диапазон ячеек на указанное число раз, основываясь на значении ячейки, и начиная с пересечения активной ячейки.

Я пролистал страницу за страницейПроблемы переполнения стека, но ни одно решение не является достаточно близким, чтобы помочь мне. 

Private Sub OKButton_Click()

Dim AppTab As String
Dim DDate As Date
Dim Rent As Long
Dim ActiveCost As Long
Dim Msg As String

AppTab = Application.Value
DDate = DispoDate.Value
Rent = RentPymt.Value
ActiveCost = Cost.Value
Msg = "Asset disposal date:"

Sheets(AppTab).Select

Range("A6:N11").Select
Selection.copy
Range("A9").Select
Selection.End(xlToRight).Offset(-3, 1).Select
ActiveSheet.Paste

ActiveCell.Offset(-5, 0).Select
ActiveCell.Value = Msg
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = DDate
ActiveCell.Offset(8, 5).Select
ActiveCell.Value = ActiveCost
ActiveCell.Offset(1, -5).Activate

Dim DataEntry As Worksheet, DataSht As Worksheet
Dim ItemName As Range, ItemCount As Range
Dim NRow As Long, TargetCell As Range

With ThisWorkbook
    Set DataEntry = .ActiveSheet
    Set DataSht = .ActiveSheet
End With

With DataEntry
    Set ItemName = .Range("A11")
    Set ItemCount = .Range("H3")
End With

NCol = ActiveCell.Column

With DataSht
NRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
'Set TargetCell = .Range("A" & NRow) 'This works
Set TargetCell = .Cells(NRow, NCol) 'Issue here
TargetCell.Resize(ItemCount.Value, 1).Value = ItemName.Value
End With

Range(Selection, Selection.End(xlToRight)).Select
Selection.copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste

Unload Me
End Sub

VBA: получение во время выполнения 1004: метод 'Range' объекта '_Worksheet'failed

Обновлено для добавленияКартинки, также обновлен весь Sub с информацией о форме пользователя

Я строю графики амортизации для портфеля активов.Когда кто-то утилизирует, мне нужно изменить график амортизации для нового актива стоимость / арендная плата и отслеживать его по двум разным ставкам.Инициируется пользовательской формой, в которой они вводят обновленную информацию об активах.

Я могу отлично выполнить исходный код расписания amort, но мне нужно, чтобы последующие частичные продажи были динамичными, поскольку портфель мог иметь сотни активов.(Давайте не будем говорить о том, насколько это неэффективно, потому что клиент всегда прав, и в настоящее время я делаю это, копируя и вставляя ... ...)

Original Amort Schedule Partial Disposal

1 Ответ

1 голос
/ 08 июня 2019

Я сделал некоторые предположения, основанные на том, что вы описали до сих пор, и на том, что ваш код уже делал. Пожалуйста, дайте мне знать, если это работает, как вам нужно, или дайте мне знать, и я могу помочь в дальнейшем.

Смотрите больше комментариев в коде: 

Private Sub OKButton_Click()

Dim AppTab As String
Dim DDate As String
Dim Rent As String 'this is never used
Dim ActiveCost As String
Dim Msg As String

AppTab = Application.Value 'This doesn't look quite right, it would return "Microsoft Excel" ... is that your sheet name?
DDate = DispoDate.Value
Rent = RentPymt.Value 'this is never used
ActiveCost = Cost.Value
Msg = "Asset disposal date:"

Dim DataEntry As Worksheet: Set DataEntry = ThisWorkbook.Sheets(AppTab) 'declare and set the worksheet to use - change as needed
Dim rngCopy As Range: Set rngCopy = DataEntry.Range("A6:N11") 'Set the range to copy - this could be determined more dynamically

Dim ItemCount As Long: ItemCount = DataEntry.Range("H3").Value 'set the number of rows to copy

    With rngCopy
        .Copy _
            Destination:=.Offset(, .Columns.Count) 'Copy ("A6:N11") to ("O6:AB11")

        .Offset(.Rows.Count - 1).Resize(1, .Columns.Count).Copy _
            Destination:=.Offset(.Rows.Count, .Columns.Count).Resize(ItemCount, .Columns.Count) 'Copy the last line from above, to the number of the rows in ItemCount
    End With

    'Is not a good idea to use ActiveCell... better use a fixed range, or build some rules to determine your "active" cell (i.e.: use Find).
    Dim rngActCell As Range: Set rngActCell = DataEntry.Range("P6") 'but if you insist in using ActiveCell, then use: Set rngActCell = Activecell

    'Other details
    With rngActCell
        .Offset(-5, 0).Value = Msg 'P1
        .Offset(-4, 0).Value = DDate 'P2
        .Offset(4, 5).Value = ActiveCost 'U10
    End With

Unload Me
End Sub
...