Кнопка Отправить пользовательскую форму для расчета динамической формулы + Вставить строку - PullRequest
Новая
       8

Кнопка Отправить пользовательскую форму для расчета динамической формулы + Вставить строку

0 голосов
/ 10 января 2019

Я использую следующий код для переноса данных своей пользовательской формы (из текстовых полей в соответствующие значения ячеек в строке A2), что отлично работает для меня, так как я хочу, чтобы данные добавлялись при добавлении: 

Private Sub CommandButton1_Click()

Dim emptyRow As Long

'Validation
If WorksheetFunction.CountIf(Sheets("RawData").Range("A:A"), 
Me.TextBox1.Value) = False Then
    MsgBox "Ticket Does Not Exist", vbCritical
End If

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Transfer information
With ThisWorkbook.Sheets("WOTracker")
    .Cells(2, 1).EntireRow.Insert
    .Cells(2, 1).Value = TextBox1.Value
    .Cells(2, 5).Value = TextBox2.Value
    .Cells(2, 2).Value = TextBox3.Value
    .Cells(2, 3).Value = TextBox4.Value
    .Cells(2, 6).Value = TextBox5.Value
    .Cells(2, 7).Value = ComboBox1.Value
    .Cells(2, 8).Value = ComboBox2.Value
    .Cells(2, 9).Value = TextBox8.Value
    .Cells(2, 4).Value = TextBox9.Value
    End With

'Formatting
Dim dDate As Date
dDate = DateSerial(Month(Date), Day(Date), Year(Date))
TextBox2.Value = Format(TextBox2.Value, "mm/dd/yy")
dDate = TextBox2.Value

With ThisWorkbook.Sheets("WOTracker")
    Sheets("WOTracker").Range("A2:Z2").Font.Bold = False
    Sheets("WOTracker").Range("A2:Z2").Font.Underline = xlUnderlineStyleNone
    End With
End Sub

На том же листе есть столбец L, в котором я хотел бы рассчитать разницу между текущей датой и датой, указанной в столбце E2 (в # днях), и я хотел бы, чтобы это было динамическим, поэтому, когда новая строка данные добавляются в строку A2, эта формула применяется в L2 при сохранении формулы в оставшейся части столбца L для данных, которые будут перенесены вниз.

Я пробовал копировать / pastespecial, и он не работает ....

Надеюсь, это имеет смысл.

Был бы очень признателен за помощь!

1 Ответ

0 голосов
/ 10 января 2019

Сначала я внесу некоторые организационные изменения в ваш код 

Private Sub CommandButton1_Click()

Dim emptyRow As Long

'Validation
If WorksheetFunction.CountIf(Sheets("RawData").Range("A:A"), 
Me.TextBox1.Value) = False Then
    MsgBox "Ticket Does Not Exist", vbCritical
End If

'Transfer information
With ThisWorkbook.Sheets("WOTracker")
    .Cells(2, 1).EntireRow.Insert
    'Determine emptyRow
    emptyRow = .Range("L" & Rows.Count).End(xlUp).Row 
    'changed from WorksheetFunction.CountA(Range("A:A")) + 1 so we can retrieve last  
    'row in column L
    .Cells(2, 1).Value = TextBox1.Value
    .Cells(2, 5).Value = TextBox2.Value
    .Cells(2, 2).Value = TextBox3.Value
    .Cells(2, 3).Value = TextBox4.Value
    .Cells(2, 6).Value = TextBox5.Value
    .Cells(2, 7).Value = ComboBox1.Value
    .Cells(2, 8).Value = ComboBox2.Value
    .Cells(2, 9).Value = TextBox8.Value
    .Cells(2, 4).Value = TextBox9.Value
    .Range("L2:L" & emptyRow) = "=DAYS(TODAY(),$E$2)"
End With

'Formatting <- Might consider deleting the lines containing dDate since it's never 
               'used
Dim dDate As Date
dDate = DateSerial(Month(Date), Day(Date), Year(Date))
TextBox2.Value = Format(TextBox2.Value, "mm/dd/yy")
dDate = TextBox2.Value

With ThisWorkbook.Sheets("WOTracker")
    Sheets("WOTracker").Range("A2:Z2").Font.Bold = False
    Sheets("WOTracker").Range("A2:Z2").Font.Underline = xlUnderlineStyleNone
    End With
End Sub

Строка .Range("L2:L" & emptyRow) = "=DAYS(TODAY(),$E$2)" будет вычислять разницу в днях между текущей датой и датой в ячейке E2 для каждой ячейки в столбце L.

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

.Range("L2:L" & emptyRow) = "=DAYS(TODAY(),$E$2)"

К

.Range("L2") = "=DAYS(TODAY(),$E$2)"

И операция вставки обновит формулу автоматически.

...