. , , ,

,,,

- — ,

:

-

:

5111

025115

:

..

.

2003 .


- .

:

Ø   ( , , , , - )

Ø   ( , )

Ø   ( , , , )

, .


. 4

. 5

. 5

. 6

. 7

. 7

. 8

. 9

. 10

.. 11

. 14

. 15


MS Excel, , , .

, , Excel Visual Basic (VBA) . VBA Microsoft , VBA , .

Excel , .

VBA, , Microsoft. , Word for Windows, Power Point . VBA , , Windows. Excel, , . , Excel, .

- MS Excel, VBA. , , , .

, :

1.        

2.        

3.        

:

    

    

    

    

A B C D
110608 12.10.03 9 40 30 20 60
113186 05.10.03 14 20 60 20 40
113514 01.09.03 8 40 60 80 80
113819 01.09.03 12 60 40 20 80
117648 18.10.03 21 40 40 20 60

, . , , , .

.

Dim i As Integer, j As Integer

i = 1

Do

i = i + 1

If Sheets(1).Cells(i, 1) = "" Then

j = i

Exit Do

End If

Loop

Cells(j, 1) = ¹.Text

Cells(j, 2) = Data.Value

Cells(j, 3) = pos.Text

Cells(j, 4) = time1.Value

Cells(j, 5) = time2.Value

Cells(j, 6) = AA.Value

Cells(j, 7) = bB.Value

Cells(j, 8) = cc.Value

Cells(j, 9) = dd.Value

, Click , :

Dim c As Object, d As Object

Set c = Range("A2")

Do While Not IsEmpty(c)

Set d = c.Offset(1, 0)

If c = ¹.Text Then

c.EntireRow.Delete

End If

Set c = d

Loop

End Sub

.

Dim i As Integer, j As Integer

i = 1

Do

i = i + 1

If Sheets(1).Cells(i, 1) = "" Then

j = i - 1

Exit Do

End If

Loop

For i = 3 To j

If Cells(i, 1) = ¹.Text Then

Cells(i, 2) = Data.Value

Cells(i, 3) = pos.Text

Cells(i, 4) = time1.Value

Cells(i, 5) = time2.Value

Cells(i, 6) = AA.Value

Cells(i, 7) = bB.Value

Cells(i, 8) = cc.Value

Cells(i, 9) = dd.Value

End If

Next i

End Sub

 

.

DoSort. , . :

Private Sub COPTuPOBKA(bn)

Range("A1").CurrentRegion.Sort Key1:=Range(bn), Order1:=xlAscending, Header:=xlYes, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("A1").Select

End Sub

Private Sub poPOS_Click()

COPTuPOBKA ("c1")

End Sub

:

    

    


A B C D
110608 1600 1300 1000 800
113186 1600 1300 1100 900
113514 1500 1200 900 500
113819 1700 1500 1200 1000
117648 1100 800 500 300

, .

, .

.

:

    

    

    

    


113819 05.10.03 B
110608 01.09.03 D
113186 05.10.03 C
113514 01.09.03 C
117648 23.12.03 A
113514 01.09.03 D
113514 01.09.03 B

 

1.  

2.   .

1.  

Dim e As Object, f As Object

Sheets(1).Select

ListBox1.Clear

TextBox1 = ""

TextBox2 = ""

TextBox3 = ""

TextBox4 = ""

TextBox5 = ""

TextBox6 = ""

TextBox7 = ""

TextBox8 = ""

TextBox9 = ""

Set e = Range("C2")

Do While Not IsEmpty(e)

Set f = e.Offset(1, 0)

If e.Text = ComboBox1.Text Then

ListBox1.AddItem (e.Offset(0, -1).Text)

End If

Set e = f

Loop

End Sub

Private Sub ListBox1_Click()

Dim e As Object, f As Object, k As Object, l As Object, _

a As Integer, b As Integer, c As Integer, d As Integer, _

v As Object, w As Object

Sheets(1).Select

Set e = Sheets(1).Cells(2, 2)

Set w = Sheets(2).Cells(2, 1)

Set k = Sheets(3).Cells(2, 3)

Do While Not IsEmpty(e)

Set f = e.Offset(1, 0)

If e.Text = ListBox1.Text And e.Offset(0, 1).Text = ComboBox1 Then

TextBox9.Text = e.Offset(0, -1).Text

a = e.Offset(0, 4)

b = e.Offset(0, 5)

c = e.Offset(0, 6)

d = e.Offset(0, 7)

End If

Set e = f

Loop

Do While Not IsEmpty(k)

Set l = k.Offset(1, 0)

If k.Text = ListBox1.Text And k.Offset(0, -2).Text = TextBox9.Text Then

If k.Offset(0, 1).Text = "A" Then

a = a - 1

ElseIf k.Offset(0, 1).Text = "B" Then

b = b - 1

ElseIf k.Offset(0, 1).Text = "C" Then

c = c - 1

Else

d = d - 1

End If

End If

Set k = l

Loop

TextBox1.Text = a

TextBox2.Text = b

TextBox3.Text = c

TextBox4.Text = d

Do While Not IsEmpty(w)

Set v = w.Offset(1, 0)

If w.Text = TextBox9.Text Then

TextBox5.Text = w.Offset(0, 1)

TextBox6.Text = w.Offset(0, 2)

TextBox7.Text = w.Offset(0, 3)

TextBox8.Text = w.Offset(0, 4)

End If

Set w = v

Loop

End Sub

Private Sub UserForm_Activate()

Dim c As Object, d As Object

Sheets(1).Select

Set c = Range("C2")

Do While Not IsEmpty(c)

Set d = c.Offset(1, 0)

ComboBox1.AddItem c

Set c = d

Loop

End Sub

2.   .

ListBox1.Clear

Dim i As Integer, j As Integer, l As Integer, r As Integer, z As Integer, x As Integer, a As Integer, _

b As Integer, c As Integer, d As Integer, y As Long, t As Integer, k As Integer

Do

i = i + 1

If Sheets(1).Cells(i, 1) = "" Then

j = i - 1

Exit Do

End If

Loop

i = 1

Do

i = i + 1

If Sheets(2).Cells(i, 1) = "" Then

l = i - 1

Exit Do

End If

Loop

i = 1

Do

i = i + 1

If Sheets(3).Cells(i, 1) = "" Then

r = i - 1

Exit Do

End If

Loop

For z = 2 To j

For x = 2 To r

If Sheets(3).Cells(x, 1).Text = Sheets(1).Cells(z, 1).Text And _

Sheets(3).Cells(x, 3).Text = Sheets(1).Cells(z, 2).Text Then

If Sheets(3).Cells(x, 4).Text = "A" Then

a = a + 1

ElseIf Sheets(3).Cells(x, 4).Text = "B" Then

b = b + 1

ElseIf Sheets(3).Cells(x, 4).Text = "C" Then

c = c + 1

Else

d = d + 1

End If

End If

Next x

For t = 2 To l

If Sheets(2).Cells(t, 1).Text = Sheets(1).Cells(z, 1).Text Then

y = a * Sheets(2).Cells(t, 2).Value + b * Sheets(2).Cells(t, 3).Value + _

c * Sheets(2).Cells(t, 4).Value + d * Sheets(2).Cells(t, 5).Value

End If

Next t

ListBox1.AddItem (Sheets(1).Cells(z, 1).Text)

ListBox1.List(k, 1) = Sheets(1).Cells(z, 2).Text

ListBox1.List(k, 2) = Sheets(1).Cells(z, 3).Text

ListBox1.List(k, 3) = y

k = k + 1

Next z

End Sub

, , ( , , , ).

, . VBA . , , VBA, .


1.         .. Microsoft Excel 2002: . -, 2003.

2.         ( ) .., ..

3.         ( VBA ) .., ..

: -

 

 

 

! , , , .
. , :