Range cells vba word

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

Sub NewRowWithResults()
Dim xxx As Column
Dim yyy As Cell
Dim sum As Integer
Dim cnt As Integer
 
 
For Each xxx In Selection.Range.Columns
    sum = 0
    cnt = 0
    For Each yyy In xxx.Cells
        If IsNumeric(yyy.Range.Text) Then
            sum = sum + yyy.Range.Text
            cnt = cnt + 1
        End If
    Next yyy
    ActiveDocument.Tables(1).Cell(1, 9).Range = sum
    ActiveDocument.Tables(1).Cell(1, 10).Range = cnt
Next xxx
 
'ActiveDocument.Tables(1).Cell(1, 9).Range = sum
'ActiveDocument.Tables(1).Cell(1, 10).Range = cnt
'Selection.InsertRowsBelow 1
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

'Здесь надо выделить область в таблице Word
 
Sub AverageOfSelectedColumn()
Dim x1, x2, y1, y2
''вставка таблицы X на Y
'ActiveDocument.Tables.Add Selection.Range, 5, 5
 
    'координаты выделения
    x1 = Selection.Columns.First.Index
    x2 = Selection.Columns.Last.Index
    y1 = Selection.Rows.First.Index
    y2 = Selection.Rows.Last.Index
    
    Selection.Rows.Last.Range.Rows.Add 'добавление строки под выделением
    
    ActiveDocument.Tables(1).Cell(y2 + 1, x1).Formula "=Average(above)"
End Sub

1
2
3
4
5
6
7
8
9
10

dim cb as integer ' column - begin
dim ce as integer ' column - end
dim rb as integer ' row - begin
dim re as integer ' row - end
 
cb = Selection.Range.FirstColumn
ce = Selection.Range.Columns.Count
 
rb = Selection.Range.FirstRow
re = Selection.Range.Rows.Count

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

Sub AveragesOfSelectedColumns()
Dim x1, x2, y1, y2, j
    'координаты выделения
    x1 = Selection.Columns.First.Index
    x2 = Selection.Columns.Last.Index
    y1 = Selection.Rows.First.Index
    y2 = Selection.Rows.Last.Index
    
    Selection.Rows.Last.Range.Rows.Add 'добавление строки под выделением
    
    For j = x1 To x2
        ActiveDocument.Tables(1).Cell(y2 + 1, j).Formula _
        "=sum(above)" & "/" & y2 - y1 + 1
    Next
End Sub

1

Selection.InsertRowsBelow 1

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

Sub bb()
Dim c As Cell, col1&, col2&
With Selection
  If Not .Information(wdWithInTable) Then
    MsgBox "Выделение не в таблице!", vbCritical
    Exit Sub
  End If
  col1 = .Cells(1).ColumnIndex
  col2 = .Cells(.Cells.Count).ColumnIndex
  ReDim sum(col1 To col2)
  For Each c In .Cells
    sum(c.ColumnIndex) = sum(c.ColumnIndex) + Val(c.Range.Text)
  Next
  With .Rows.Last.Range.Rows.Add 'Sasha_Smirnov
    For col1 = col1 To col2
      .Cells(col1).Range = sum(col1)
    Next
  End With
End With
End Sub

1

    sum(c.ColumnIndex) = sum(c.ColumnIndex) + Val(Replace(c.Range.Text, ",", "."))

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

Option Explicit
 
'здесь надо выделить область в таблице Word
 
Sub AveragesOfColumnsOfSelection()
Dim x1, x2, y1, y2, j
'выход при отсутствии Таблицы 1 и при выделении вне её
If ActiveDocument.Tables.Count = 0 Then Exit Sub
If Not Selection.InRange(ActiveDocument.Tables(1).Range) Then Exit Sub
 
    'координаты выделения
    x1 = Selection.Columns.First.Index
    x2 = Selection.Columns.Last.Index
    y1 = Selection.Rows.First.Index
    y2 = Selection.Rows.Last.Index
    
    Selection.Rows.Last.Range.Rows.Add 'добавление строки под выделением
    
    'перевод номера колонки (1, 2, 3, 4, …) в вид: a, b, c, d, … [не пригодился!]
    
    For j = 64 + x1 To 64 + x2                              'код буквы A = 64 + 1
        ActiveDocument.Tables(1).Cell(y2 + 1, j - 64).Formula _
        "=sum([" & Chr(j) & y1 & ":" & Chr(j) & y2 & "])" & "/" & y2 - y1 + 1
    Next
'в документе, если видны не вычисленные значения, а коды, надо нажать Alt-F9
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

Sub bb()
Dim c As Cell, col1&, col2&, ci&, ct$
With Selection
  If Not .Information(wdWithInTable) Then
    MsgBox "Выделение не в таблице!", vbCritical
    Exit Sub
  End If
  col1 = .Cells(1).ColumnIndex
  col2 = .Cells(.Cells.Count).ColumnIndex
  ReDim sum(col1 To col2), cnt(col1 To col2)
  For Each c In .Cells
    ct = c.Range.Text
    ct = Left$(ct, Len(ct) - 2)
    If IsNumeric(ct) Then
      ci = c.ColumnIndex
      sum(ci) = sum(ci) + CDbl(ct)
      cnt(ci) = cnt(ci) + 1
    End If
  Next
  With .Rows.Last.Range.Rows.Add 'Sasha_Smirnov
    For col1 = col1 To col2
      If cnt(col1) > 0 Then .Cells(col1).Range = sum(col1) / cnt(col1)
    Next
  End With
End With
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

Sub NewRowWithResults()
Dim rb As Integer
Dim re As Integer
Dim cb As Integer
Dim ce As Integer
Dim cl As Cell, ct$
 
If Not Selection.Information(wdWithInTable) Then
    MsgBox "Выделение за пределами таблицы!", vbCritical
    Exit Sub
End If
 
rb = Selection.Rows.First.Index
re = Selection.Rows.Last.Index
cb = Selection.Columns.First.Index
ce = Selection.Columns.Last.Index
 
Selection.InsertRowsBelow 1
 
For i = cb To ce
    sum = 0
    cnt = 0
    For j = rb To re
        ct = ActiveDocument.Tables(1).Cell(j, i).Range.Text
        ct = Left$(ct, Len(ct) - 2)
        If IsNumeric(ct) Then
          sum = sum + CDbl(ct)
          cnt = cnt + 1
        End If
    Next j
    If sum <> 0 Then
        ActiveDocument.Tables(1).Cell(re + 1, i).Range = sum / cnt
    End If
Next i
End Sub

1

Dim cl As Cell, ct$