注册 登录
编程论坛 VB6论坛

字典法:If Not d.Exists(k) Then 这句好像不起作用,请修改

vbcaonia 发布于 2023-04-25 17:10, 555 次点击
在Form2.VSFlexGrid1.TextMatrix(i, 3)一列中,各单元格中的数据相邻二个空一格,每8行一组,将各组中1到20且没有出现的数据提取出来,提取出来的数据相邻二个空一格串接存放在变量crr中,采用下列程序,字典法:If Not d.Exists(k) Then
这句好像不起作用,因为结果crr总是1-20,这20个数据不变(本程序在vba中运行正常)。

请老师修改一下,谢谢!

Private Sub Command24_Click()
Dim t$
t = Timer
Dim d As Object, arr(), brr, drr, crr, i As Long, j As Long, k As Long, m As Long, s, ke, n As Long
  Dim sy
    Set d = CreateObject("scripting.dictionary")
   
      
        For i = 1 To 80 Step 8
        If Form2.VSFlexGrid1.TextMatrix(i, 3) <> "" Then
           crr = ""
           For m = i To i + 7
            brr = Split(Trim(Form2.VSFlexGrid1.TextMatrix(m, 3)))
            
            For j = 0 To UBound(brr)
                If Not d.Exists(brr(j)) Then d.add brr(j), ""
            Next j
             Next m
   
         

           
               For k = 1 To 20
               If Not d.Exists(k) Then
             crr = crr & " " & k
                End If
              Next k
              
           MsgBox crr
        If MsgBox("确认要退出?", vbYesNo) = vbYes Then End
        
   
            Else
            Exit For
            End If
            d.RemoveAll
        Next i

MsgBox Timer - t
End Sub

[此贴子已经被作者于2023-4-25 18:32编辑过]

2 回复
#2
东海ECS2023-04-25 18:46
请修改以下程序,将字典法部分的代码改为循环判断:

程序代码:
Private Sub Command24_Click() Dim t$ t = Timer Dim d As Object, arr(), brr, drr, crr, i As Long, j As Long, k As Long, m As Long, s, ke, n As Long Dim sy Set d = CreateObject("scripting.dictionary")

    For i = 1 To 80 Step 8
    If Form2.VSFlexGrid1.TextMatrix(i, 3) <> "" Then
       crr = ""
       For m = i To i + 7
        brr = Split(Trim(Form2.VSFlexGrid1.TextMatrix(m, 3)))
        
        For j = 0 To UBound(brr)
            If Not d.Exists(brr(j)) Then d.add brr(j), ""
        Next j
         Next m

         For k = 1 To 20
         ke = False
            For Each s In d.keys
            If s = k Then
            ke = True
            Exit For
            End If
            Next s
            If Not ke Then crr = crr & " " & k
          Next k
         
       MsgBox crr
    If MsgBox("确认要退出?", vbYesNo) = vbYes Then End
   

        Else
        Exit For
        End If
        d.RemoveAll
    Next i
MsgBox Timer - t End Sub
#3
vbcaonia2023-04-25 22:35
回复 2楼 东海ECS
程序满足要求,谢谢版主!
1