пересчет данных в таблице по примеру.

[vkopitsa]

Доброе время суток! Помогите пожалуйста .
Возможно ли как-то сделать чтобы в таблице пересчитывались данные, таблицы очень большие бывают и вручную это очень долго делать, пытался найти, но ненашол. Структура таблиц одинаковая. Описные и пример в архиве.

Заранее благодарю, и большое спасибо.

[viter.alex]

Думаю, что сделать можно. Глянув на ваш пример, я почти уверен, что можно. Но за плату.

[vkopitsa]

А может хоть подскажите как?

[viter.alex]

Подскажу. У вас есть 10 столбцов с данными. В зависимости от расположения данных в столбцах, нужно производить определённые действия с числами в ячейках. Вот и нужно определять программно в каких столбцах находятся числа, сравнивать с шаблоном и выполнять нужные действия. Работа не столько сложная программно, сколько очень трудоёмкая. Думаю, что цена будет в районе 50 у.е.

[vkopitsa]

Может быть и заказал, нооо финансы поют романсы.

[Aent]

vkopitsa, а что бы вам не считать вашу таблицу в EXCEL?
А если результат должен быть в Word - перенести не трудно...

[vkopitsa]

Как сделать, чтобы вытягивать текст с 3-х первых найденных ячеек с 6-ти, и делило любоэ число с 3-х первых найденных на 2 и вставляло результат в остальные 3-и. И выделяло красным цветом.

Private Sub CommandButton5_Click()

Dim tbl As Table, cll As Cell, i As Long
i = 0


For Each tbl In ActiveDocument.Tables
  For Each cll In tbl.Range.Cells
    If IsNumeric(Replace(cll.Range, Chr(13) + Chr(7), "")) Then i = i + 1 Else i = 0
    
    
    If i = 6 Then

    cll.Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
    cll.Range.Text = Val(cll.Range.Text) / Val(2)

      i = 0
     
    End If
  Next
Next

End Sub

[vkopitsa]

Учусь методом научного втыка!

Как сделать чтобы выделило в ряд, выделение тянет вверх

Private Sub CommandButton7_Click()
Dim tbl As Table, cll As Cell, i As Long
i = 0
b = 0

For Each tbl In ActiveDocument.Tables
  For Each cll In tbl.Range.Cells
    If IsNumeric(Replace(cll.Range, Chr(13) + Chr(7), "")) Then i = i + 1 Else i = 0
    If i = 6 Then
      MsgBox "Ура, нашел 6 числовых ячеек подряд"
      
 'tbl.Cell(Row, i - 6).Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
'  tbl.Cell(Row, i - 5).Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
'  tbl.Cell(Row, i - 4).Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
'   tbl.Cell(Row, i - 3).Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
'    tbl.Cell(Row, i - 2).Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
'     tbl.Cell(Row, i - 1).Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
'tbl.Cell(Row, i - 3).Range.Text = Val(tbl.Cell(Row, -6).Range.Text) / Val(2)
'tbl.Cell(Row, i - 2).Range.Text = Val(tbl.Cell(Row, -4).Range.Text) / Val(2)
'cll.Range.Text = Val(tbl.Cell(Row, -3).Range.Text) / Val(2)
'For i = 1 To n + 1

For j = 5 To 8

tbl.Cell(row, j).Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
'tbl.Cell(Row, b + 6).Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
'tbl.Cell(Row, b + 7).Range.Shading.BackgroundPatternColor = RGB(255, 0, 0)
Next j
'Next i
     i = 0
    End If
  Next
Next
End Sub