Как найти несколько элементов с помощью vba, а затем использовать эти значения для расчета изменений из набора данных Dynami c?

Question

Я пытаюсь написать код, который ищет данные на основе общего идентификатора, а затем вычисляет процентную разницу между первой записью и следующей записью данных. Однако я связал его с пользовательской формой VBA, которая вводит данные в электронную таблицу, поэтому база данных имеет динамический характер c.

В идеале я хотел бы отобразить «% изменения с момента первой записи» и «% изменения с момента последней записи» в текстовом поле в моей пользовательской форме, а также сброс в таблицу Excel.

Так, например, смотрите прилагаемое изображение;

Данные Excel - Пример

Скажите, что я должен был введите слово «Собака» в текстовом поле в пользовательской форме. В текстовом поле для:

• "% Изменить с момента первой записи" на дисплее будет 60%,
• "% Изменить с последней записи" на дисплее будет 100% ".

В идеале я пытаюсь добраться до точки, к которой я могу построить график изменения процентного соотношения с течением времени, но я пытаюсь обдумать лучший способ сначала решите эту проблему.

Option Explicit
 Public b As String

 Private Sub CommandButton1_Click()
 Dim nm, v, pcf, pc As Variant, cNext As Range
 Dim ws As Worksheet, vFirst, vLast
 Dim Cell ' you had c but changed to cell as it worked for me.

 Set ws = ThisWorkbook.Sheets("Sheet1")
 Set cNext = ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0) 'next empty 
                                                                    'row

   b = TextBox1.Value ' was nm changed to be to suit what I had.

  'find the current first and last values
       For Each Cell In ws.Range("A2", cNext.Offset(-1, 0))
        If Cell.Value = b Then
        If IsEmpty(vFirst) Then vFirst = Cell.Offset(0, 2).Value 'first                                                              
                                                                'occurrence
         vLast = Cell.Offset(0, 2).Value                          'last 
                                                               ' occurrence
        End If
   Next Cell 'changed from loop to next cell

    v = TextBox2.Value
   pcf = percent(v, vFirst)
   pc = percent(v, vLast)

    'add values to sheet at next empty row
    cNext.Resize(1, 5).Value = Array(b, TextBox5.Value, v, pcf, pc)'this is 
                                                                     'cool

    TextBox3.Value = pcf
    TextBox4.Value = pc
  End Sub

'Percentage change  formula
 Function percent(x, y)

    If x And y = 0 Or x = 0 Or y = 0 Then
      percent = Format(0, "Percent")
    Else
      percent = Format(((x - y) / y), "Percent")
    End If

  End Function
  Private Sub UserForm_Initialize()
  TextBox5 = Now
  TextBox5 = Format(TextBox5.Value, "dd mmm yyyy")
  End Sub

Answer 1

Это немного короче. Вы можете пропустить некоторый код, если не добавляете текущую запись на лист, только в go, ища ее снова ...

Private Sub Cb_Click()
    Dim nm, v, pcf, pc As Variant, cNext As Range
    Dim ws As Worksheet, vFirst, vLast

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set cNext = ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0) 'next empty row

    nm = TextBox1.Value

    'find the current first and last values
    For Each c In ws.Range("A2", cNext.Offset(-1, 0))
        If c.Value = b Then
            If IsEmpty(vFirst) Then vFirst = c.Offset(0, 2).Value 'first occurence
            vLast = c.Offset(0, 2).Value                          'last occurence
        End If
    Loop

    v = TextBox2.Value
    pcf = percent(v, vFirst)
    pc = percent(v, vLast)

    'add values to sheet at next empty row
    cNext.Resize(1, 5).Value = Array(b, TextBox5.Value, v, pcf, pc)

    TextBox3.Value = pcf
    TextBox4.Value = pc

End Sub