[字典与数组二期1班] 第2讲作业上交帖

JLxiangwei · 发表于 2011-12-27 12:40

本帖最后由 JLxiangwei 于 2011-12-28 15:04 编辑

Function Jc(rg As Range, Optional i As Long = 1)
Dim d As New Dictionary, d1 As New Dictionary, y&, arr, ar, s$
arr = rg
For Each ar In arr
d(ar) = d(ar) + 1
Next
For y = 0 To d.Count - 1
d1(d.Items(y)) = ""
Next y
n = Application.Large(d1.Keys, i)
If i > d1.Count Then Exit Function
For y = 0 To d.Count - 1
If d.Items(y) = n Then
s = s & d.Keys(y) & "|"
End If
Next y
Jc = Left(s, Len(s) - 1)
End Function
Sub 必做二()
Dim sh As Worksheet, d As New Dictionary, x&, arr
With Sheets("必做二")
For Each sh In Sheets
If sh.Name <> "必做二" And sh.Tab.ColorIndex = .Tab.ColorIndex Then
arr = sh.Range("a2:b" & sh.Cells(sh.Rows.Count, 2).End(3).Row)
For x = 1 To UBound(arr)
d(arr(x, 1)) = d(arr(x, 1)) + Val(arr(x, 2))
Next x
End If
Next
.Range("a2:b" & Rows.Count).ClearContents
.[a1] = "产品型号"
.[b1] = "数量"
.[a2].Resize(d.Count) = Application.Transpose(d.Keys)
.[b2].Resize(d.Count) = Application.Transpose(d.Items)
End With
End Sub
Sub 选做一()
Dim d As New Dictionary, arr, x&, str$, str1$, arr1
With Sheets("选做一")
arr = .Range("a2:b" & .Cells(.Rows.Count, 2).End(3).Row).Formula
str = Range("E1")
For x = 1 To UBound(arr)
If arr(x, 1) = str Then
str1 = str1 & Mid(arr(x, 2), 2, 20) & "+"
End If
Next
arr1 = VBA.Split(str1, "+")
.Range("e2:e" & Rows.Count).ClearContents
.[e2].Resize(UBound(arr1)) = Application.Transpose(arr1)
End With
End Sub
Sub 选做二()
Dim d As New Dictionary, arr, x&, arr1(1 To 10, 1 To 7), y&
arr = Sheet11.Range("a1:g" & Sheet11.Cells(Sheet11.Rows.Count, 6).End(3).Row)
Do
x = Rnd() * (UBound(arr) - 1) + 1
d(x) = ""
Loop Until d.Count = 10
For x = 1 To 10
For y = 1 To 7
arr1(x, y) = arr(d.Keys(x - 1), y)
Next y
Next x
Sheet5.Range("a1").Resize(10, 7) = arr1
End Sub
Sub 附加题()
Dim d As New Dictionary, d1 As New Dictionary, sht As Worksheet
Dim arr, i&, k&, arr1, m&, j&, str1$, t, n&
t = Timer
k = Sheet10.Cells(Sheet10.Rows.Count, 2).End(3).Row
arr = Sheet10.Range("a1:s" & k).Value
For i = 2 To UBound(arr)
d(arr(i, 14)) = ""
Next
For Each sht In Sheets
d1(sht.Name) = ""
Next
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 0 To UBound(d.Keys)
If d1.Exists(d.Keys(i)) Then
str1 = MsgBox(d.Keys(i) & "工作表已存在,是否删除?", vbYesNo)
If str1 = vbYes Then
Sheets(d.Keys(i)).Delete
Else
GoTo 100
End If
End If
Sheets.Add after:=Sheets(Sheets.Count)
100
Sheets(d.Keys(i)).Select
With ActiveSheet
.Name = d.Keys(i)
m = 0
ReDim arr1(1 To k, 1 To UBound(arr, 2))
For j = 2 To UBound(arr, 1)
If arr(j, 14) = d.Keys(i) Then
m = m + 1
For n = 1 To UBound(arr, 2)
arr1(m, n) = arr(j, n)
Next n
End If
Next j
.[a1:s1] = Application.Index(arr, 1)
.[a2].Resize(k, UBound(arr, 2)) = arr1
End With
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

复制代码

9lee · 发表于 2011-12-27 16:00

本帖最后由 9lee 于 2011-12-27 16:06 编辑

Private Function Jc(rng, Optional n As Long = 1)'9lee
Dim arr, d As New Dictionary, nMax, a, i, j, x, dd As New Dictionary
On Error Resume Next
'======第一参数不是数组时,显示错误值
If IsArray(rng) = False Then Jc = "#VALUE!": Exit Function
arr = rng
'========确定数组的维数
For x = 1 To 64
If IsEmpty(UBound(arr, x)) Then Exit For
Next
'========统计各元素出现的次数
If x = 2 Then '一维时
For i = 1 To UBound(arr)
If IsEmpty(arr(i)) = False Then d(arr(i)) = d(arr(i)) + 1
Next
Else '二维时
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2)
If IsEmpty(arr(i, j)) = False Then d(arr(i, j)) = d(arr(i, j)) + 1
Next j
Next i
End If
'======统计出现次数的值
For i = 0 To d.Count - 1
dd(d.Items(i)) = ""
Next
'===如果第二参数大于次数的值的个数,则显示空值
If n > dd.Count Then Jc = "": Exit Function
'====
nMax = Application.Large(dd.Keys, n)
'====获取出现N次的元素
For i = 0 To d.Count - 1
If d.Items(i) = nMax Then a = a & "|" & d.Keys(i)
Next
Jc = Mid(a, 2, 10000)
Set d = Nothing
Set dd = Nothing
End Function

复制代码

Sub 必做二_9lee()
Dim d As New Dictionary, arr, i, sh As Worksheet, a
With Sheets("必做二")
a = Sheets("必做二").Tab.ColorIndex
For Each sh In ThisWorkbook.Sheets
If sh.Tab.ColorIndex = a And sh.Name <> "必做二" Then
arr = sh.Range("a1").CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2) * 1
Next i
End If
Next
.Range("a:b").ClearContents
.Range("a1") = "产品型号"
.Range("b1") = "数量"
If d.Count > 0 Then
.Range("a2:a" & d.Count) = Application.Transpose(d.Keys)
.Range("b2:b" & d.Count) = Application.Transpose(d.Items)
End If
End With
Set d = Nothing
End Sub

复制代码

Sub 选做二_9lee()
Dim brr, d As New Dictionary
Dim a, irow, i
t = Timer
With Sheets("选做二数据源")
a = .[a65536].End(3).Row
Do
irow = Int(a * Rnd + 1)
If Not d.Exists(d(irow)) Then
d(irow) = .Cells(irow, 1).EntireRow
End If
i = i + 1
Loop Until i = 10
End With
brr = Application.Transpose(Application.Transpose(d.Items))
With Sheets("选做二")
.Range("a1").CurrentRegion.ClearContents
.[a1].Resize(10, UBound(brr, 2)) = brr
End With
Set d = Nothing
MsgBox Timer - t
End Sub

复制代码

Sub 选做一_9lee()
Dim arr, brr, chaxun As String, d As New Dictionary
With Sheets("选做一")
.[e2:e65536].ClearContents
chaxun = UCase(.[e1])
arr = Range("a1").CurrentRegion.Formula
For i = 2 To UBound(arr)
If UCase(arr(i, 1)) Like chaxun Then
d(i) = Mid(arr(i, 2), 2, 10000)
End If
Next
If d.Count > 0 Then
brr = Split(Join(d.Items, "+"), "+")
.[e2].Resize(UBound(brr)) = Application.Transpose(brr)
Else
MsgBox .[e1] & "没有找到!"
End If
End With
Set d = Nothing
End Sub

复制代码

Sub 附加题_9lee()
Dim arr, brr, crr(), d As New Dictionary, d_Name As New Dictionary, dd As New Dictionary
Dim i, j, my, k, m
Application.ScreenUpdating = False
t = Timer
With Sheets("附加题")
arr = .Range("a1").CurrentRegion
brr = .Rows(1)
'=============获取拆分项目
For i = 2 To UBound(arr, 1)
d(arr(i, 14)) = ""
Next
'============获取已有的工作表名称
For Each sh In ThisWorkbook.Sheets
d_Name(sh.Name) = ""
Next
'=========拆分
For i = 0 To d.Count - 1
Set sh = Sheets.Add(after:=Sheets(ThisWorkbook.Sheets.Count))
'==========判断工作表是否存在,选择是否需要删除
If d_Name.Exists(d.Keys(i)) Then
my = MsgBox(d.Keys(i) & "的工作表已存在,是否需要删除该工作表?", vbYesNo)
If my = vbYes Then
Application.DisplayAlerts = False
Sheets(d.Keys(i)).Delete
sh.Name = d.Keys(i)
Application.DisplayAlerts = True
End If
Else
sh.Name = d.Keys(i)
End If
ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
For j = 2 To UBound(arr)
If arr(j, 14) = d.Keys(i) Then
For k = 1 To UBound(arr, 2)
crr(m + 1, k) = arr(j, k)
Next k
m = m + 1
End If
Next
sh.[a1].Resize(1, UBound(brr, 2)) = brr
sh.[a2].Resize(UBound(crr, 1), UBound(crr, 2)) = crr
Set dd = Nothing
m = 0
Next
End With
Set d = Nothing
Set d_Name = Nothing
MsgBox "拆分完毕!用时" & Timer - t & "秒."
Application.ScreenUpdating = True
End Sub

复制代码

qushui · 发表于 2011-12-27 18:49

Function jc(arr, Optional n% = 1) As String '必做一
Dim d As New Dictionary
If TypeName(arr) = "Range" Then
arr = arr.Value
For i = LBound(arr) To UBound(arr)
For j = LBound(arr, 2) To UBound(arr, 2)
If d.Exists(arr(i, j)) Then
d(arr(i, j)) = d(arr(i, j)) + 1
Else
d.Add arr(i, j), 1
End If
Next j
Next i
Else
For i = LBound(arr) To UBound(arr)
d(arr(i)) = d(arr(i)) + 1
Next i
End If
For k = 0 To d.Count - 1
If d.Items(k) = n Then
If jc = "" Then
jc = d.Keys(k)
Else
jc = jc & "|" & d.Keys(k)
End If
End If
Next k
End Function[code]
Sub huizong() '必做二
Dim d As New Dictionary
Dim sht As Worksheet
Dim a%, b&, arr
Sheets("必做二").Select
a = Me.Tab.ColorIndex
For Each sht In Sheets
If sht.Name <> "必做二" Then
If sht.Tab.ColorIndex = a Then
If Not IsEmpty(arr) Then Erase arr
b = 0
b = sht.Cells(Rows.Count, 1).End(3).Row
arr = sht.Range("a2:b" & b).Value
For i = 1 To b - 1
For j = 1 To 2
d(arr(i, 1)) = d(arr(i, 1)) + Val(arr(i, 2))
Next j
Next i
End If
End If
Next sht
[a1:b1] = Array("产品型号", "汇总数量")
[a2].Resize(d.Count, 1) = Application.Transpose(d.Keys)
[b2].Resize(d.Count, 1) = Application.Transpose(d.Items)
End Sub

复制代码

[/code]

Sub 选做一()
Dim d As New Dictionary
Dim a$, aa$, bb$, arr, brr
Sheets("选做一").Select
arr = Range("a2:a" & Cells(Rows.Count, 1).End(3).Row)
For i = 1 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) & Cells(i + 1, 2).Formula
Next i
a = d(Trim(Cells(1, 5)))
If Not IsEmpty(a) Then
aa = Replace(a, "=", "+")
bb = Replace(aa, "+", "", , 1)
brr = Split(bb, "+")
[e2].Resize(UBound(brr) + 1, 1).ClearComments
[e2].Resize(UBound(brr) + 1, 1) = Application.Transpose(brr)
Else
MsgBox "此产品型号不存在！"
End If
End Sub

复制代码

Sub 选做二()
Dim arr(1 To 10, 1 To 7), a(1 To 10) As Long, b&, m&
Sheets("选做二数据源").Select
m = Cells(Rows.Count, 1).End(3).Row
For i = 1 To 10
again:
b = Rnd * m + 1
For j = 1 To i - 1
If b = a(j) Then GoTo again
Next j
a(i) = b
For j = 1 To 7
arr(i, j) = Cells(b, j)
Next j
Next i
Sheets("选做二").Select
[a1:g10].ClearComments
[a1:g10] = arr
End Sub

复制代码

Sub 拆分() '附加题
Dim arr, brr, m&, a%, ss$
Sheets("附加题").Select
Application.ScreenUpdating = False
m = Cells(Rows.Count, 14).End(3).Row
arr = Range("n2:n" & m)
Dim d As New Dictionary
For i = 1 To m - 1
If Not d.Exists(arr(i, 1)) Then
d.Add arr(i, 1), i + 1
Else
d(arr(i, 1)) = d(arr(i, 1)) & "|" & i + 1
End If
Next i
For i = 0 To d.Count - 1
a = 0
ss = d.Keys(i)
For j = 1 To Sheets.Count
If Sheets(j).Name = ss Then a = MsgBox("表名已经存在，是否删除已有工作表？", 4 + 32 + 0 + 0, "请选择")
If a = 6 Then Sheets(ss).Delete
Next j
If a <> 7 Then
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = ss
[a1:s1].Value = Sheets("附加题").[a1:s1].Value
ps = Split(d.Items(i), "|")
t = UBound(ps)
ReDim brr(t)
Sheets("附加题").Select
For k = 0 To t
brr(k) = Range(Cells(ps(k), "A"), Cells(ps(k), "S"))
Next k
Sheets(ss).Select
For w = 2 To t + 2
Range(Cells(w, 1), Cells(w, 19)) = brr(w - 2)
Next w
Columns("A:S").AutoFit
Erase brr, ps
End If
Next i
Application.ScreenUpdating = True
End Sub

复制代码

ldxhzy · 发表于 2011-12-27 23:10

第2讲作业上交,请老师批改。附加题暂未做。

rem 必做一，函数
Public Function Ldxhzy(Sou As Range, Optional Cs As Long = 1) As String
Rem ò
Dim MyArr(), TmpK(), TmpI(), Tmp()
Dim MyDic As New Dictionary
Dim I As Long, J As Long
Dim M As Long
Dim TmpStr As String
I = Sou.Rows.Count
J = Sou.Columns.Count
ReDim MyArr(1 To I, 1 To J)
MyArr = Sou
For I = 1 To UBound(MyArr, 1) 'à×
For J = 1 To UBound(MyArr, 2)
If Not IsEmpty(MyArr(I, J)) Then 'í
If MyDic.Exists(MyArr(I, J)) Then
MyDic.Item(MyArr(I, J)) = MyDic.Item(MyArr(I, J)) + 1
Else
MyDic.Add MyArr(I, J), 1
End If
End If
Next J
Next I
ReDim Tmp(1 To MyDic.Count, 1 To 2)
TmpK = MyDic.Keys 'TmpK±ê　
TmpI = MyDic.Items
For I = 0 To UBound(TmpK) '××é
Tmp(I + 1, 1) = TmpK(I)
Tmp(I + 1, 2) = Val(TmpI(I))
Next I
For I = 1 To UBound(Tmp, 1) '°óò
TmpStr = Tmp(I, 1)
M = Tmp(I, 2)
For J = I + 1 To UBound(Tmp, 1)
If M < Tmp(J, 2) Then '
Tmp(I, 1) = Tmp(J, 1)
Tmp(I, 2) = Tmp(J, 2)
Tmp(J, 1) = TmpStr
Tmp(J, 2) = M
End If
Next J
Next I
M = Application.WorksheetFunction.Large(TmpI, Cs)
Ldxhzy = ""
For I = 1 To UBound(Tmp, 1)
If Tmp(I, 2) = M Then
Ldxhzy = Ldxhzy & "|" & Tmp(I, 1)
End If
Next I
Ldxhzy = IIf(Len(Ldxhzy) > 1, Mid(Ldxhzy, 2), "")
End Function

复制代码

rem 必做二，过程代码
Private Sub CommandButton1_Click()
Dim Ys As Long
Dim I As Long
Dim Ws As Worksheet
Dim Sou(), Tmp(), Xh(), Sl()
Dim MyDic As New Dictionary
Ys = ActiveSheet.Tab.ColorIndex
For Each Ws In ThisWorkbook.Sheets
If (Ws.Tab.ColorIndex = Ys) And (Ws.Name <> Me.Name) Then
I = Ws.UsedRange.Rows.Count
Tmp = Ws.Range("A2:B" & I)
For I = 1 To UBound(Tmp, 1)
If MyDic.Exists(Tmp(I, 1)) Then
MyDic.Item(Tmp(I, 1)) = MyDic.Item(Tmp(I, 1)) + Val(Tmp(I, 2))
Else
MyDic.Item(Tmp(I, 1)) = Val(Tmp(I, 2))
End If
Next I
End If
Next
Xh = MyDic.Keys
Sl = MyDic.Items
I = UBound(Xh) - LBound(Xh) + 1
Range("A:B").ClearContents
ActiveSheet.Range("A1").Resize(1, 2) = Array("ú·", "")
ActiveSheet.Range("A2").Resize(I, 1) = Application.WorksheetFunction.Transpose(Xh)
ActiveSheet.Range("B2").Resize(I, 1) = Application.WorksheetFunction.Transpose(Sl)
End Sub

复制代码

rem 选做一，代码
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$1" Then
Dim MyArr(), MyTag()
Dim I As Long
I = UsedRange.Rows.Count
ReDim MyArr(1 To I - 1, 1 To 2)
MyArr = Range("A2:B" & I).Formula
For I = 1 To UsedRange.Rows.Count - 1
If MyArr(I, 1) = Target.Value Then
ReDim Preserve MyTag(1 To I)
MyTag(I) = "'" & MyArr(I, 2)
End If
Next I
I = UBound(MyTag)
Range("E2:E" & UsedRange.Rows.Count).Resize(I, 1) = Application.WorksheetFunction.Transpose(MyTag)
End If
End Sub

复制代码

rem 选做二，过程代码
Private Sub CommandButton1_Click()
Dim I As Long, M As Long
Dim MyDic As New Dictionary
Dim Tmp()
I = ThisWorkbook.Sheets("×").UsedRange.Rows.Count
While MyDic.Count < 10
M = Int(Rnd() * I + 1)
MyDic(M) = M
Wend
Tmp = MyDic.Items
For I = 0 To 9
Range("A" & (I + 1)).Resize(1, 7) = ThisWorkbook.Sheets("×").Range("A" & Tmp(I) & ":G" & Tmp(I)).Value
Next I
End Sub

复制代码

jsgslgd · 发表于 2011-12-27 23:56

近段时间忙，第一题不会做，只做了第二题，先上交了。

字典班第2讲作业2023-jsgslgd.zip (1.76 MB, 下载次数: 11)

happym8888 · 发表于 2011-12-28 10:14

报告老师，一道题都不会做。

swabe · 发表于 2011-12-28 11:20

本帖最后由 swabe 于 2011-12-28 14:30 编辑

'必做一
Function jc(a As Variant, Optional b As Long = 1)
Application.Volatile
Dim arr, arrtmp
Dim dic As New Dictionary
Dim arrdata
Dim x&, i&, y$
arr = a
For Each arrdata In arr
dic(arrdata) = dic(arrdata) + 1
Next
arrtmp = dic.Items
x = Application.WorksheetFunction.Large(arrtmp, b)
For i = 0 To dic.Count - 1
If dic(dic.Keys(i)) = x Then
y = y & "|" & dic.Keys(i)
End If
Next
jc = Mid(y, 2, Len(y) - 1)
End Function

复制代码

Sub swabe_必做二()
Dim dic As New Dictionary
Dim sht As Worksheet
Dim i As Long, x As Long
Dim arr, arrtmp, arrtmp2
x = Sheet3.Tab.Color
For Each sht In Worksheets
If sht.Name <> Sheet3.Name And sht.Tab.Color = x Then
arr = sht.Range("a2:B" & sht.Range("a65536").End(xlUp).Row)
For i = 1 To UBound(arr)
dic(arr(i, 1)) = dic(arr(i, 1)) + arr(i, 2) * 1
Next
End If
Next
arrtmp = dic.Keys
arrtmp2 = dic.Items
Sheet3.Range("A1").Resize(dic.Count, 1) = Application.Transpose(arrtmp)
Sheet3.Range("b1").Resize(dic.Count, 1) = Application.Transpose(arrtmp2)
End Sub

复制代码

'选做一 (工作表代码)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$E$1" Then Exit Sub
Dim dic As New Dictionary
Dim arr
Dim i&, x$
x = Target.Value
arr = Range("A2:B" & Range("A65536").End(xlUp).Row).Formula
For i = 1 To UBound(arr)
dic(arr(i, 1)) = dic(arr(i, 1)) & "+" & Mid(arr(i, 2), 2, Len(arr(i, 2)))
Next
arr = Application.Transpose(Split(Mid(dic(x), 2, Len(dic(x))), "+"))
Range("E2").Resize(UBound(arr)) = arr
End Sub

复制代码

Sub swabe_选做二()
Dim arr, arrtmp(1 To 10, 1 To 7)
Dim dic As New Dictionary
Dim x&, y&, i%, j%
arr = Sheet11.Range("A1:G" & Range("A65536").End(xlUp).Row)
x = UBound(arr)
Do
y = Int(Rnd() * x + 1)
dic(y) = ""
Loop Until dic.Count = 10
For i = 1 To 10
For j = 1 To 7
arrtmp(i, j) = arr(dic.Keys(i - 1), j)
Next
Next
Sheet11.Range("A1").Resize(10, 7) = arrtmp
End Sub

复制代码

Sub swabe_附加题()
Application.ScreenUpdating = False
Dim dic_sht As New Dictionary
Dim dic As New Dictionary
Dim sht As Worksheet
Dim i&, x&, y%, j&
Dim arrdata, arr_top, arrtmp
Dim pd As Boolean
For Each sht In Sheets
dic_sht(sht.Name) = ""
Next
With Sheets("附加题")
arrdata = .Range("A2:S" & .Range("N65536").End(xlUp).Row)
arr_top = .Range("A1:S1")
End With
'
For i = 1 To UBound(arrdata)
dic(arrdata(i, 14)) = ""
Next
For i = 0 To dic.Count - 1
If dic_sht.Exists(dic.Keys(i)) Then
pd = MsgBox("工作表" & dic(i) & "己存在！", vbYesNo)
If pd = vbYes Then
Application.DisplayAlerts = False
Sheets(dic(dic(i))).Delete
Sheets.Add(after:=Sheets.Count).Name = dic.Keys(i)
Application.DisplayAlerts = True
End If
Else
Worksheets.Add(after:=Sheets(Sheets.Count)).Name = dic.Keys(i)
End If
ReDim arrtmp(1 To UBound(arrdata), 1 To 19)
x = 1
For j = 2 To UBound(arrdata)
If arrdata(j, 14) = dic.Keys(i) Then
For y = 1 To 19
arrtmp(x, y) = arrdata(j, y)
Next
x = x + 1
End If
Next
With Sheets("附加题")
Sheets(dic.Keys(i)).Range("A1:S1") = arr_top
Sheets(dic.Keys(i)).Range("A2").Resize(UBound(arrtmp), 19) = arrtmp
End With
Next
Application.ScreenUpdating = True
End Sub

复制代码

那么的帅 · 发表于 2011-12-28 15:14

001-那么的帅-作业2.rar (1.37 MB, 下载次数: 38)

pdsxff · 发表于 2011-12-28 18:14

只做了第一题，感觉挺难，也没调试通过，总提示VBA.Filter不正确，希望老师能指导下。

Function jc(ByRef arr, ByVal dj As Integer) As String
  Dim d, d2, arr2, arr3

  Dim i As Integer

  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1

  For i = 1 To arr.Count
d(arr(i)) = d(arr(i)) + 1
  Next

  arr2 = d.Items

  For i = 1 To arr2.Count
d2(arr2(i)) = ""
  Next

  djval = Application.Large(d2.Keys, dj)
  arr3 = VBA.Filter(d.Keys, djval & "")
  jc = arr3



End Function

dtxczjzmp · 发表于 2011-12-28 18:34

郁闷死了，一题都不会做，我基础太差了，再加年底很忙，也来不及去复习！很对不起老师苦心教导！

		自动登录	找回密码
密码			注册

[习题] [字典与数组二期1班] 第2讲作业上交帖

点评

点评

点评