,,,
:
-
:
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 ) .., ..
: -
Copyright (c) 2024 Stud-Baza.ru , , , .