Question

用VB怎么从EXCEL里面找出同样数据？

RT 如：
例如:
姓名 分数
张三 10
王五 20
李四 11
周六 18
郑七 20
张三 19
王五 12
周六 13
李四 17
如何变成
张三 10,19
李四 11,17
郑七 20
王五 12,20
周六 13,18
有两个数据中间加"逗号"
在SHEET2中 列出来呢？

Answer 1

1.插入元素
Option Base 1
Dim a()
Dim n As Integer

Private Sub Command1_Click()
Dim i, j, m As Integer
m = InputBox("请输入要插入的元素")
n = n + 1
ReDim Preserve a(n)
For i = 1 To n - 1
If m < a(i) Then
Exit For
End If
Next
For j = n To i + 1 Step -1
a(j) = a(j - 1)
Next
a(i) = m
Print "插入元素" & m & "后的数组为："
For i = 1 To n
Print a(i);
Next
Print
End Sub

Private Sub Form_Load()
Dim i As Integer, j%, k%, t%
ReDim a(10)
Show
For i = 1 To 10
a(i) = Int(Rnd * 199 + 1)
Next
n = UBound(a)
For i = 1 To n - 1
For j = 1 To n - i
If a(j) > a(j + 1) Then
t = a(j): a(j) = a(j + 1): a(j + 1) = t
End If
Next
Next

Print "插入前数组："
For k = 1 To n
Print a(k);
Next
Print
End Sub
2.二进制
Private Sub Command1_Click()
Dim n%
n = Text1.Text
Text2.Text = tran(n)
End Sub
Private Function tran(n As Integer) As String
Dim m As String, r%, flag As Boolean
flag = False
If n < 0 Then
n = Abs(n)
flag = True
End If
Do While n >= 1
r = n Mod 2
n = n \ 2
m = Str(r) & m
Loop
If flag = True Then
m = "-" & m

End If
tran = m
End Function
3.加密
Option Explicit
Private Sub Command1_Click()
Dim x As String
x = Text1.Text
Text2.Text = jiami(x)
End Sub
Function jiami(m As String) As String
Dim i As Integer, x As String
For i = 1 To Len(m)
x = Mid(m, i, 1)
If Asc(x) >= 65 And Asc(x) <= 90 Then
jiami = jiami & Chr(155 - Asc(x))
ElseIf Asc(x) >= 97 And Asc(x) <= 122 Then
jiami = jiami & Chr(219 - Asc(x))
End If
Next
End Function
4.矩阵
Option Explicit
Option Base 1
Private Sub Command1_Click()
Dim a(5, 5)
Dim i As Integer, j As Integer
Dim s1 As Integer, s2 As Integer, s3 As Integer, s4 As Integer, s As Integer, m As String

For i = 1 To 5
For j = 1 To 5
If i = j Or i + j = 6 Then
a(i, j) = 1
Else
a(i, j) = Int(Rnd * 9 + 1)
End If
Next
Next
For i = 1 To 5
m = ""
For j = 1 To 5
m = m & " " & a(i, j)
Next
List1.AddItem m
Next
For i = 1 To 5
s1 = s1 + a(i, 1)
Next
For i = 1 To 5
s2 = s2 + a(i, 5)
Next
For j = 2 To 4
s3 = s3 + a(1, j)
Next
For j = 2 To 4
s4 = s4 + a(5, j)
Next
s = s1 + s2 + s3 + s4
List1.AddItem "四周元素之和为：" & s
End Sub
5.字符组成统计
Dim ss As String
Public Sub tongji()
Dim i As Integer, large As Integer, small As Integer, num As Integer
Show
For i = 1 To Len(ss)
If Asc(Mid(ss, i, 1)) >= Asc("A") And Asc(Mid(ss, i, 1)) <= Asc("Z") Then
large = large + 1 '如果在大写字母的代码数字范围内
Else
If Asc(Mid(ss, i, 1)) >= Asc("a") And Asc(Mid(ss, i, 1)) <= Asc("z") Then
small = small + 1
Else
If Asc(Mid(ss, i, 1)) >= 48 And Asc(Mid(ss, i, 1)) <= 57 Then
num = num + 1
End If
End If
End If
Next i
Print "大写字母个数：" & large
Print "小写字母个数：" & small
Print "数字个数：" & num
End Sub

Private Sub Form_Load()
ss = InputBox("请输入字符串：")
Call tongji
Print "共有" & Len(ss) & "个字符"
End Sub
6.评委打分
Option Base 1
Private Type C
number As Integer
score As Single
End Type
Dim a(4) As C

Private Sub Command1_Click()
Dim max As Integer, min As Integer, i As Integer, j As Integer, mark As Integer
For i = 1 To 4
a(i).number = i
max = 1
min = 100
'Randomize
For j = 1 To 6
mark = Int(Rnd * 100 + 1)
If mark > max Then max = mark
If mark < min Then min = mark
Print mark;
a(i).score = a(i).score + mark
Next
a(i).score = (a(i).score - max - min) / 4
Print a(i).score
Next

End Sub

Private Sub Command2_Click()
Dim i, j As Integer, m As C
For i = 1 To 3
For j = 1 To 4 - i
If a(j).score < a(j + 1).score Then
m = a(j)
a(j) = a(j + 1)
a(j + 1) = m
End If
Next
Next
For i = 1 To 4
Print "歌手" & a(i).number & " " & a(i).score & "分"
Next
End Sub
7.一元二次方程
Private Sub Command1_Click()
Dim a#, b#, c#, x!, y!, m#
a = Text1.Text: b = Text2.Text: c = Text3.Text
x = -b / (2 * a)
m = b ^ 2 - 4 * a * c
y = Sqr(Abs(m)) / 2 / a
Select Case m '判断m的正负决定根的情况
Case Is > 0
Text4.Text = x + y
Text5.Text = x - y
Case Is = 0
Text4.Text = x
Text5.Text = x
Case Is < 0
Text4.Text = x & "+" & y & "i" '虚数单位
Text5.Text = x & "-" & y & "i"
End Select
End Sub

Private Sub Command2_Click()
Text1.Text = "": Text2.Text = "": Text3.Text = "": Text4.Text = "": Text5.Text = ""
End Sub
8.删除元素
Option Base 1
Dim a()
Dim n As Integer

Private Sub Command1_Click()
Dim m As Integer, flag As Boolean
Dim i, j As Integer
flag = False
m = InputBox("请输入要删除的元素")
i = 1
Do
If a(i) = m Then
flag = True
n = n - 1
For j = i To n
a(j) = a(j + 1)
Next
ReDim Preserve a(n)
i = i - 1
End If
i = i + 1
Loop Until i > n
If flag = False Then
MsgBox m & "不在原数组中"
Else
Print "删除" & m & "后数组为："
For i = 1 To n
Print a(i);
Next
Print
End If
End Sub

Private Sub Form_Load()
Dim i As Integer
Show
a = Array(2, 3, 3, 5, 12, 29, 58, 67, 258, 590)
n = UBound(a)
Print "删除前数组为："
For i = 1 To n
Print a(i);
Next
Print
End Sub
9.3-100素数
Private Sub Command1_Click()
Print "3-100之间的所有素数为"
Dim n%
For n = 3 To 100
If isprime(n) Then '调用函数
Call prtprime(n) '调用过程
End If
Next n
End Sub

Function isprime(n As Integer) As Boolean
Dim i%
isprime = True
For i = 2 To Int(Sqr(n))
If n Mod i = 0 Then
isprime = False
Exit For
End If
Next i
End Function
Sub prtprime(n As Integer)
Static cnt As Integer '静态变量cnt用来计数
Print n;
cnt = cnt + 1
If cnt Mod 4 = 0 Then Print
End Sub
10.菱形
Private Sub Command1_Click()
Dim n%, a%
n = InputBox("请输入行数n")
If n Mod 2 = 0 Or n < 3 Then '如果输入的不是奇数就报错
a = MsgBox("请输入奇数", vbOKOnly + vbExclamation)
End If
If n Mod 2 <> 0 And n >= 3 Then Call tp(n)
End Sub

Private Sub tp(x As Integer)
Dim i%, m%
m = 25 '先将m放在中间位置，使图像展开
For i = 1 To (x + 1) / 2 '直到最多的那行
m = m - 1 '每多一个字母，向前写一位
Print Tab(m); String(2 * i - 1, Chr(64 + i)) '确定每行写几个，后面的按字母顺序输出
Next i 'String(N,S)是重复输出N个S字符 大写A是65 小写a是97
For i = (x + 1) / 2 + 1 To x '从最多的那行下一行开始写
m = m + 1
Print Tab(m); String(2 * (x + 1 - i) - 1, Chr(64 + x + 1 - i)) '注意此处的x+1-i
Next i
End Sub
11.数组交换
Option Base 1
Dim a(20) As Integer

Private Sub Command1_Click()
Dim i, t As Integer
For i = 1 To 10
t = a(i)
a(i) = a(21 - i)
a(21 - i) = t
Next
Print "交换后的数组为："
For i = 1 To 20
Print a(i);
If i = 10 Then Print
Next
End Sub

Private Sub Form_Load()
Dim i As Integer
Show
Randomize
Print "交换前的数组为："
For i = 1 To 20
a(i) = Int(Rnd * 90 + 10)
Print a(i);
If i = 10 Then Print
Next
Print
End Sub

12.素数列表框
Private Sub Command1_Click()
Dim min As Integer, max As Integer, t As Integer, i As Integer
List1.Clear
min = Text1.Text
max = Text2.Text
If min > max Then
t = min
min = max
max = t
End If
For i = min To max
If sushu(i) Then
List1.AddItem i
End If
Next
End Sub
Function sushu(n As Integer) As Boolean
Dim i As Integer
sushu = True
For i = 2 To n - 1
If n Mod i = 0 Then
sushu = False
Exit For
End If
Next
End Function

13.随机数排序
Public n As Integer, i%
Dim a() As Integer

Private Sub Command1_Click()
Dim i%, j%, t%
Print
Print "用比较交换法排序："
For i = 1 To n - 1
For j = i + 1 To n
If a(j) < a(i) Then
t = a(i): a(i) = a(j): a(j) = t
End If
Next j
Print a(i);
Next i
Print a(n)
End Sub

Private Sub Command2_Click()
Dim m%, p%, s%
Print
Print "用冒泡法排序："
For s = 1 To n - 1
For p = 1 To n - s
If a(p) > a(p + 1) Then
m = a(p): a(p) = a(p + 1): a(p + 1) = m '依次从第一个开始同最后一个比较，把越大的放在越后面
End If
Next p '一轮比较从1到n-1
Next s '开始下一轮比较，从1到n-2
For s = 1 To n
Print a(s);
Next s
End Sub

Private Sub Form_Load()
Show
n = InputBox("请输入正整数n")
ReDim a(n)
Print "排序前"
For i = 1 To n
a(i) = Int(Rnd * (10 * n) + 1)
Print a(i);
Next i
End Sub

14.杨辉三角
Private Sub command1_click()
Dim n%, a() As Integer, i%, j%, e%, g%
n = InputBox("please:")
ReDim a(n, n)
e = 50
For i = 1 To n
e = e - 5
g = e
For j = 1 To i
If j = 1 Or i = j Then
a(i, j) = 1
Else
a(i, j) = a(i - 1, j - 1) + a(i - 1, j)
End If
Picture1.Print Tab(g); a(i, j);
g = g + 10
Next
'Picture1.Print
Next
End Sub

15.公约数公倍数
Private Sub Command1_Click()
Dim m%, n%
Call gb(m, n)
Print "最大公约数为" & gy(m, n) & Chr(13) & Chr(10) & "最小公倍数为" & gb(m, n)
End Sub

Private Function gy(a As Integer, b As Integer) As Integer
Dim x%
a = Text1.Text: b = Text2.Text
If a > b Then
x = a: a = b: b = x '将a作为小的数字，b是大的数字
End If
Do While b Mod a <> 0 '如果b不能整除a
x = a: a = b Mod a: b = x '让a等于b除以a的余数
Loop
gy = a
End Function
Private Function gb(y1 As Integer, y2 As Integer) As Integer
Dim x1%, x2%
gb = Val(Text1.Text) * Val(Text2.Text) / gy(x1, x2) '两数乘积除以两数的公约数就是最小公倍数
End Function

16.兔子
Public n%

Private Sub Command1_Click()
Dim i%, sum%
For i = 1 To n
sum = sum + ditui(i) '调用函数ditui
Next i
Print sum
End Sub
Function ditui(ByVal n As Integer) As Integer
If n = 1 Then
ditui = 1
ElseIf n = 2 Then
ditui = 1
Else
ditui = ditui(n - 1) + ditui(n - 2)
End If
End Function

Private Sub Command2_Click()
Print digui(n)
End Sub
Function digui(ByVal n As Integer) As Integer
Dim a%, b%, c%, s%, j%
a = 1: b = 1
For j = 3 To n
c = a + b
a = b: b = c
s = s + c
Next
If n = 1 Then
digui = 1
Else
digui = 1 + 1 + s
End If
End Function

Private Sub Command3_Click()
n = InputBox("请输入月份数")
Print "第" & n & "个月"
End Sub

Answer 2

Sub hjs()
Dim i As Integer

Application.ScreenUpdating = False
For i = 1 To 31
Sheets("生产信息表").copy After:=Sheets("生产信息表")
Next
Application.ScreenUpdating = True
End Sub
----------------
根据你的描述，修正如上，建议注意代码运行时的逻辑，运用计算机语言理解