. VBA VisualBasicforApplications MS Excel. Excel 7 . ݻ (. 11) , . .
(12). . :
- , . "",
- .
, , .
. (.12).
, .
Sub ()
Application.ScreenUpdating = 0
m = 6
k = 2
' fio (2)
While Application.Workbooks(1).Worksheets(2).Cells(k, 1) <> ""
fio = Application.Workbooks(1).Worksheets(2).Cells(k, 1).Value
' fio
Worksheets(4).Cells(m, 2) = fio
m = m + 1
p = m
' fio ( 1 ) ( 3 )
For i = 6 To 130
For j = 39 To 65
If Worksheets(1).Cells(i, j).Value = fio Then
Worksheets(1).Select
Range(Cells(i, 2), Cells(i, 34)).Select
Selection.Copy
Worksheets(4).Select
Cells(m, 5).Select
ActiveSheet.Paste
m = m + 1
End If
Next
Next
'
t = "=sum(AK" + Trim(Str(p)) + ":AK" + Trim(Str(m - 1)) + ")"
Application.Workbooks(1).Worksheets(4).Cells(m, 37) = t
'
Application.Workbooks(1).Worksheets(4).Cells(m, 3) = ""
Range(Worksheets(4).Cells(m, 1), Worksheets(4).Cells(m, 41)).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
m = m + 1
k = k + 1
Wend
Application.ScreenUpdating = 1
End Sub
(. 13).
. . . . , , . .
|
|
|
, . I II :
- (.14);
- (.15);
- (.16);
- (.17).
excel , , MS Word.
Private Sub CommandButton2_Click()
'
Application.ScreenUpdating = 0
k1 = 2
n = 1
' fio ( 1 ) ( 3 )
For i = 6 To 130
For j = 39 To 65
Worksheets(1).Select
'
If Cells(i, j) <> "" Then '1
'
If Cells(i, 25) <> 0 Then
If (Cells(i, 5) = 1 Or Cells(i, 5) = 3 Or Cells(i, 5) = 5 Or Cells(i, 5) = 7) Then ' 2 (i, 5) 1,3,5,7,
t1 = Cells(i, 2) '
t2 = Cells(i, 3) '
t3 = Cells(i, j) '
' 5
Worksheets(5).Select
Cells(k1, 5) = t1
Cells(k1, 2) = t2
Cells(k1, 7) = t3
Cells(k1, 1) = n
k1 = k1 + 1
n = n + 1
End If
End If
'
If (Worksheets(1).Cells(i, 5) = 1 Or Worksheets(1).Cells(i, 5) = 2) Then Worksheets(5).Cells(k1, 4) = "1"
ElseIf (Worksheets(1).Cells(i, 5) = 3 Or Worksheets(1).Cells(i, 5) = 4) Then Worksheets(5).Cells(k1, 4) = "2"
ElseIf (Worksheets(1).Cells(i, 5) = 5 Or Worksheets(1).Cells(i, 5) = 6) Then Worksheets(5).Cells(k1, 4) = "3"
ElseIf (Worksheets(1).Cells(i, 5) = 7 Or Worksheets(1).Cells(i, 5) = 8) Then Worksheets(5).Cells(k1, 4) = "4"
End If
Next
Next
Worksheets(5).Select
r = 1
While Cells(r, 1) <> ""
r = r + 1
Wend
'MsgBox r
Range(Cells(1, 1), Cells(r, 7)).Copy
Set oWord = CreateObject("Word.Application") ' Ms Word
oWord.Visible = True
Set oDoc = oWord.Documents.Add()
oDoc.Activate
With oWord.Selection
.Font.Bold = True
.Font.Size = 16
.TypeText Text:=" "
.TypeParagraph
End With
oWord.Selection.Paste
Application.ScreenUpdating = 1
End Sub
