求指导一下吧。！删除行后不能再添加了。。

[qq4126488]

求大神帮忙，如果需要报酬，可以商量，加QQ 4126488 电话 [phone]
现在在删除原有一行的商品后， 在添加 就添加不了

Public IDlist As Collection
Private Sub txtHy_KeyPress(KeyAscii As Integer)
    If Trim(txtHy.Text) = Empty Then Exit Sub
    If KeyAscii <> 13 Then Exit Sub
    Dim SQL2 As String
    Dim MsgText As String
    
    SQL2 = "select * from hy where card='" & Trim(txtHy.Text) & "'"
    Set RsHy = ExecuteSQL(SQL2, MsgText)
    If Not RsHy.EOF Then
        If IsNull(RsHy("name")) = False And RsHy("name") <> Empty Then lblHyName.Caption = RsHy("name") Else lblHyName.Caption = ""
        lblHyJf.Caption = RsHy("jf")
        lblHyPis.Caption = RsHy("pis")
        chkHyJs.Enabled = True
        txtHyOut.Enabled = True
        txtHyIn.Enabled = True
    Else
        chkHyJs.Enabled = False
        lblHyJf.Caption = 0
        lblHyPis.Caption = 0
        lblHyName.Caption = "..."
    End If
    
End Sub

Private Sub Grid1_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim Idx&
    
    If Grid1.TextMatrix(Grid1.RowSel, 1) = "" Then Exit Sub
        If KeyCode = vbKeyDelete Then
        If Grid1.Rows > 2 Then
        For i = 1 To IDlist.Count
            Idx = Val(Grid1.TextMatrix(Grid1.RowSel, 13))
            Debug.Print Idx
            If Idx < IDlist.Count Then IDlist.Remove Idx
        Next
            Grid1.RemoveItem Grid1.RowSel: Grid1.Refresh
            HeJi
        
        End If
    End If
End Sub

[cqq_chen]

信息不全，无法看出问题...

[饮水需思源]

建议这样来操作数据库： 增加记录： conn.execute "INSERT INTO 表名(字符型字段,数值型字段) VALUES('"& 字符型变量 &"',"& 数值型变量 &")" 修改记录： conn.execute "UPDATE 表名 SET ... WHERE ..." 删除记录： conn.execute "DELTE FROM 表名 WHERE ..."

[qq4126488]

Private Sub Grid1_KeyUp(KeyCode As Integer, Shift As Integer)

    
   Dim Idx&
    Dim SpName As String
    
    If Grid1.TextMatrix(Grid1.RowSel, 1) = "" Then Exit Sub
    
    
    If KeyCode = vbKeyDelete Then
        SpName = Grid1.TextMatrix(Grid1.RowSel, 2)
        If MsgBox("确定不需要【" & SpName & "】吗？！", vbYesNo + vbQuestion, "删除提示") = vbYes Then
            If Grid1.Rows > 2 Then
                For i = 1 To IDlist.Count
                    If IDlist.Item(i) = Grid1.TextMatrix(Grid1.RowSel, Grid1.Cols - 1) Then
                        IDlist.Remove i
                        Exit For
                    End If
                    
                Next
                Grid1.RemoveItem Grid1.RowSel: Grid1.Refresh
                If Grid1.Rows = 2 Then Unload Me: Me.Show
                HeJi
                
            End If
        End If
    End If
End Sub

我自己来结贴吧，朋友帮忙处理好了

[qq4126488]

上面的代码我也没发对。被 bcrun 气的。我发全代码吧 那位朋友有用就复制下去用吧。

Dim RsHy As ADODB.Recordset
Dim Pid As Long




Private Sub chkHyJs_Click()
    If chkHyJs.Value = xtpChecked Then
        If Val(lblHyPis.Caption) >= Val(txtPis.Text) Then
            txtHyOut = Format(lblPis.Caption, "")
            txtHyIn = Val(lblHyPis.Caption) - Val(lblPis.Caption)
            txtPis = 0
        Else
            txtHyOut = lblHyPis.Caption
            txtHyIn = 0
            txtPis = Val(txtPis) - Val(lblHyPis.Caption)
            
        End If
    Else
    txtPis = Format(lblPis.Caption, "")
    txtHyOut = 0
    txtHyIn = 0
    End If
    txtInPis_Change
End Sub



Private Sub cmd_Click(Index As Integer)
    Select Case Index
        Case 0
            TxtTm_KeyPress 13
        Case 1
            Grid1_KeyUp vbKeyDelete, 0
        
    End Select
End Sub

Private Sub Form_Load()
    Dim RsBh As ADODB.Recordset, MsgText As String
    sqlBh = "select * from Sell_Main order by id"
    Set RsBh = ExecuteSQL(sqlBh, MsgText)
    FormatGrid
    Grid1.Rows = 2
    If RsBh.RecordCount > 0 Then
       RsBh.MoveLast
       lblCode.Caption = "XS" & Format(Now, "yyyymmdd") & left(Mid(RsBh("billcode"), 11, 17), 7) + 1
    Else
       lblCode.Caption = "XS" & Format(Now, "yyyymmdd") & "1000001"
    End If
    RsBh.Close
    Set RsBh = Nothing
    Set IDlist = New Collection
    Pic1.Visible = False
    Grid.Visible = False
End Sub


Private Sub Grid1_AfterEdit(ByVal Row As Long, ByVal Col As Long)
    With Grid1
    c = .TextMatrix(Row, 5)
        If c <> "" Then
                
            For i = 1 To .Rows - 1
                  .TextMatrix(i, 6) = Val(.TextMatrix(i, 5)) * Val(.TextMatrix(i, 3))
                  .TextMatrix(i, 7) = Val(.TextMatrix(i, 6)) * Val(.TextMatrix(i, 8))
                  .TextMatrix(i, 10) = Val(.TextMatrix(i, 9)) * Val(.TextMatrix(i, 5))
                  .TextMatrix(i, 11) = Val(.TextMatrix(i, 5)) * Val(.TextMatrix(i, 4))
                  .TextMatrix(i, 12) = Val(.TextMatrix(i, 11)) * Val(.TextMatrix(i, 8))
            Next
            HeJi
        End If
    End With
End Sub





Private Sub Grid1_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
  '*******先将设editable=2
  '限定不可编辑列,如有5列

  If Col = 0 Then Cancel = True
  If Col = 1 Then Cancel = True
  If Col = 2 Then Cancel = True
  If Col = 3 Then Cancel = True
  If Col = 4 Then Cancel = True
  If Col = 6 Then Cancel = True
    If Col = 7 Then Cancel = True
End Sub

Private Sub Grid1_KeyPressEdit(ByVal Row As Long, ByVal Col As Long, KeyAscii As Integer)
Dim Numbers As String        '允许输入的字符

If Grid1.Col = 5 Then    '第5列
  Numbers = "1234567890" + Chr(46) + Chr(8)
  If InStr(Numbers, Chr(KeyAscii)) = 0 Then
    KeyAscii = 0
  End If
End If


End Sub

Private Sub Grid1_KeyUp(KeyCode As Integer, Shift As Integer)

    
   Dim Idx&
    Dim SpName As String
    
    If Grid1.TextMatrix(Grid1.RowSel, 1) = "" Then Exit Sub
    
    
    If KeyCode = vbKeyDelete Then
        SpName = Grid1.TextMatrix(Grid1.RowSel, 2)
        If MsgBox("确定不需要【" & SpName & "】吗？！", vbYesNo + vbQuestion, "删除提示") = vbYes Then
            If Grid1.Rows > 2 Then
                For i = 1 To IDlist.Count
                    If IDlist.Item(i) = Grid1.TextMatrix(Grid1.RowSel, Grid1.Cols - 1) Then
                        IDlist.Remove i
                        Exit For
                    End If
                    
                Next
                Grid1.RemoveItem Grid1.RowSel: Grid1.Refresh
                If Grid1.Rows = 2 Then Unload Me: Me.Show
                HeJi
                
            End If
        End If
    End If
End Sub




Private Sub txtHy_KeyPress(KeyAscii As Integer)
    If Trim(txtHy.Text) = Empty Then Exit Sub
    If KeyAscii <> 13 Then Exit Sub
    Dim SQL2 As String
    Dim MsgText As String
    
    SQL2 = "select * from hy where card='" & Trim(txtHy.Text) & "'"
    Set RsHy = ExecuteSQL(SQL2, MsgText)
    If Not RsHy.EOF Then
        If IsNull(RsHy("name")) = False And RsHy("name") <> Empty Then lblHyName.Caption = RsHy("name") Else lblHyName.Caption = ""
        lblHyJf.Caption = RsHy("jf")
        lblHyPis.Caption = RsHy("pis")
        chkHyJs.Enabled = True
        txtHyOut.Enabled = True
        txtHyIn.Enabled = True
    Else
        chkHyJs.Enabled = False
        lblHyJf.Caption = 0
        lblHyPis.Caption = 0
        lblHyName.Caption = "..."
    End If
    
End Sub

Private Sub txtInPis_Change()
    If txtInPis = "" Then
        TxtOutPis = ""
    Else
        TxtOutPis.Text = Val(txtInPis.Text) - Val(txtPis.Text)
    End If
End Sub

Private Sub txtJmPis_KeyPress(KeyAscii As Integer)
    If Trim(txtJmPis.Text) = Empty Then Exit Sub
    If KeyAscii <> 13 Then Exit Sub
    txtPis.Text = Val(lblPis.Caption) - Val(txtJmPis.Text)
    txtInPis_Change
End Sub

Private Sub TxtTm_KeyPress(KeyAscii As Integer)
    If Trim(TxtTm.Text) = Empty Then Exit Sub
    If KeyAscii <> 13 Then Exit Sub
    Dim SQL1 As String
    Dim MsgText As String
    Dim RS1 As ADODB.Recordset
    SQL1 = "select * from SP where TM='" & Trim(TxtTm.Text) & "'"
    Set RS1 = ExecuteSQL(SQL1, MsgText)
    If Not RS1.EOF Then
    FormatGrid
     With Grid1
            .Editable = flexEDKbdMouse '不编辑
            .SelectionMode = 1
        For i = 1 To IDlist.Count '将ID数记录在 IDlist 这个集合里,防止有同名重复行出现!
            If RS1.Fields(0).Value = IDlist(i) Then
                For q = 1 To .Rows - 2    '这里用循环来判断(q,条码列号)=txttm" 列值数量+1
                    If .TextMatrix(q, 1) = TxtTm.Text Then
                        .TextMatrix(q, 5) = .TextMatrix(q, 5) + 1
                        .TextMatrix(q, 6) = .TextMatrix(q, 5) * .TextMatrix(q, 3)
                        If RS1("jf") = True Then
                            .TextMatrix(q, 7) = RS1("jfl") * .TextMatrix(q, 6)
                            .TextMatrix(q, 12) = RS1("jfl") * .TextMatrix(q, 4)
                        Else
                            .TextMatrix(q, 7) = 0: .TextMatrix(q, 12) = 0
                        End If
                        .TextMatrix(q, 10) = .TextMatrix(q, 9) * .TextMatrix(q, 5)
                        .TextMatrix(q, 11) = .TextMatrix(q, 4) * .TextMatrix(q, 5)
                        .Row = q '焦点移动到当前行
                        Exit For
 
                    
                    End If
                Next
                GoTo HeJi1
            End If
        Next
NewAdd:
          .Rows = .Rows + 1
            .TextMatrix(.Rows - 2, 1) = RS1("tm")  '条码
            .TextMatrix(.Rows - 2, 2) = RS1("name") '名称
            .TextMatrix(.Rows - 2, 3) = RS1("sellpis") '零售价
            .TextMatrix(.Rows - 2, 4) = RS1("hypis")  '会员价
            .TextMatrix(.Rows - 2, 5) = 1 ' 数量
            .TextMatrix(.Rows - 2, 6) = .TextMatrix(.Rows - 2, 3) * .TextMatrix(.Rows - 2, 5) '金额
            If RS1("jf") = True Then
                .TextMatrix(.Rows - 2, 7) = RS1("jfl") * .TextMatrix(.Rows - 2, 5) * .TextMatrix(.Rows - 2, 3) '积分
                .TextMatrix(.Rows - 2, 8) = RS1("jfl") '积分率
            Else: .TextMatrix(.Rows - 2, 7) = 0: .TextMatrix(.Rows - 2, 8) = 0: End If
            .TextMatrix(.Rows - 2, 9) = RS1("inpis") '进价
            .TextMatrix(.Rows - 2, 10) = .TextMatrix(.Rows - 2, 5) * .TextMatrix(.Rows - 2, 9) '成本
            .TextMatrix(.Rows - 2, 11) = .TextMatrix(.Rows - 2, 5) * .TextMatrix(.Rows - 2, 4) '会员总价
            .TextMatrix(.Rows - 2, 12) = .TextMatrix(.Rows - 2, 11) * .TextMatrix(.Rows - 2, 8) '会员积分
            .Row = .Rows - 2
            .TextMatrix(.Rows - 2, 13) = RS1.Fields(0).Value
            IDlist.Add RS1.Fields(0).Value
            
        End With
HeJi1: '合计
    HeJi

        
    End If
    TxtTm.Text = ""
    TxtTm.SetFocus
End Sub
Public Sub HeJi()
    With Grid1
        For i = 1 To .Rows - 1
              SumNum = SumNum + Val(.TextMatrix(i, 5))
              SumHJ = SumHJ + Val(.TextMatrix(i, 6))
              SumJF = SumJF + Val(.TextMatrix(i, 7))
              SumCB = SumCB + Val(.TextMatrix(i, 10))
              SumHy = SumHy + Val(.TextMatrix(i, 11))
              SumHyJf = SumHyJf + Val(.TextMatrix(i, 12))
              .TextMatrix(.Rows - 2, 0) = i - 1
        Next
        lblSl.Caption = SumNum
        lblPis.Caption = Format(SumHJ, "0.00")
        txtPis = SumHJ
        lblJf.Caption = SumJF
        SumHyZ = SumHy
        SumHyJfZ = SumHyJf
        SumCBZ = SumCB
    End With
End Sub
Public Sub FormatGrid()
  With Grid1
    .Cols = 14
    .SelectionMode = 1
    .FormatString = "^ 行号 |< 商品条码 |< 商品名称 |> 零售价 |> 会员价|> 数 量 |> 金 额 |>  积 分|>  积分率|>  进价|>  成本|>  折价|>  折分"
    .ColWidth(0) = 500: .ColWidth(1) = 1000: .ColWidth(2) = 2000: .ColWidth(3) = 1000
    .ColWidth(4) = 1000: .ColWidth(5) = 1000: .ColWidth(6) = 1200: .ColWidth(7) = 0: .ColWidth(8) = 0
    .ColWidth(9) = 0: .ColWidth(10) = 0: .ColWidth(11) = 0: .ColWidth(12) = 20: .ColWidth(13) = 600
    '6行后的宽度在调试期间为显示状态。正常运行时，宽度改为0
    .RowHeight(-1) = 330

    End With
End Sub

[qq4126488]

Private Sub cmdJz_Click()
    Dim Rsr As ADODB.Recordset
    Dim RsMx As ADODB.Recordset
    Dim RsSp As ADODB.Recordset

    Dim Mid As Long
    Dim MsgText As String
    Dim TSQL As String
    
    If lblSl.Caption = 0 Then MsgBox "无销售商品，不能结账!  ", vbCritical: Exit Sub
    
    '主帐目表操作
    TSQL = "select * from Sell_main"
    Set Rsr = ExecuteSQL(TSQL, MsgText)
        If Rsr.BOF Or Rsr.EOF Then
            Pid = 1
        Else
            Rsr.MoveLast
            Pid = Rsr("pid") + 1
        End If
        MidPrn = Pid
   
        Rsr.AddNew
        If lblHyName.Caption <> "..." Then
            
            Rsr("hycode") = txtHy.Text
            Rsr("HyJf") = lblJf.Caption  'SumHyJfZ
            If chkHyJs.Value = xtpChecked Then
                Rsr("HyPis") = txtHyIn.Text
            Else
                Rsr("HyPis") = 0
                
            End If
            
        ElseIf hyId <> "" Then
            Rsr("hycode") = 0
            Rsr("HyJf") = 0
            Rsr("HyPis") = 0
        End If
        Rsr("Pid") = Pid
        Rsr("Billtype") = "销售"
        Rsr("Billcode") = lblCode.Caption
        Rsr("Billdate") = Now
        Rsr("Num") = lblSl.Caption
        Rsr("FullPis") = lblPis.Caption
        Rsr("SfPis") = txtPis.Text
        Rsr("lirong") = Val(txtPis.Text) - SumCBZ
        Rsr("chenben") = SumCBZ
        Rsr("JieMian") = txtJmPis
        Rsr("InPis") = txtInPis
        Rsr("OutPis") = TxtOutPis
        'Rsr("") = txt
        Rsr("czy") = Czy
        Rsr.Update
        Rsr.Close
        
        
        '会员表操作
    If lblHyName.Caption <> "..." Then
        RsHy("jf") = RsHy("jf") + Val(lblJf.Caption)
        RsHy("jfpis") = RsHy("jfpis") + Val(txtPis.Text)
        RsHy("jfnum") = RsHy("jfnum") + 1
        RsHy("lastpis") = txtPis.Text
        RsHy("lastdate") = Now
        If chkHyJs.Value = xtpChecked Then
            RsHy("Pis") = 0
        End If
        RsHy.Update
        RsHy.Close
        Set RsHy = Nothing
    End If
        '加入明细表

        TSQL = "select * from Sell_mx"
        Set RsMx = ExecuteSQL(TSQL, MsgText)
        

    
    With Grid1
        For i = 1 To .Rows - 2
            RsMx.AddNew
                RsMx("PID") = Pid
                RsMx("billcode") = lblCode.Caption
                RsMx("billtype") = "销售"
                RsMx("billdate") = Now
                RsMx("lid") = .TextMatrix(i, 0)
                RsMx("tm") = .TextMatrix(i, 1)
                RsMx("name") = .TextMatrix(i, 2)
                RsMx("pis") = .TextMatrix(i, 3)
                RsMx("num") = .TextMatrix(i, 5)
                RsMx("sumpis") = .TextMatrix(i, 6)
            RsMx.Update
            TxtSQL = "select * from sp where tm='" & Grid1.TextMatrix(i, 1) & "'"
            Set RsSp = ExecuteSQL(TxtSQL, MsgText)
            RsSp("num") = RsSp("num") - .TextMatrix(i, 5)
            RsSp.Update
        Next
    
    End With
    RsMx.Close
    Set RsMx = Nothing
    RsSp.Close
    Set RsSp = Nothing
    PrintOut
    MsgBox "销售成功！继续下一单", vbInformation, "提示"
    Unload Me
    Me.Show

    
End Sub


Public Sub PrintOut()
'On Error GoTo ErrorPrint
    Dim UserNAME As String, Tel As String, Address As String, UserINFO As String
    Dim RS As ADODB.Recordset, MsgText As String, Sql As String
    Sql = "select * from UserInfo"
    Set RS = ExecuteSQL(Sql, MsgText)
 '   If Trim(RS("userName")) <> "" Or IsNull(RS("userName")) = False Then UserNAME = RS("userName")
 '   If Trim(RS("TEL")) <> "" Or IsNull(RS("TEL")) = False Then Tel = RS("TEL")
 '   If Trim(RS("广告词")) <> "" Or IsNull(RS("广告词")) = False Then UserINFO = RS("广告词")
 '   If Trim(RS("address")) <> "" Or IsNull(RS("address")) = False Then Address = RS("address")
    RS.Close
    Set RS = Nothing
    
    Sql = "select name as 商品名称,pis as 单价,num as 数量,sumpis as 金额 from sell_mx where pid=" & Pid & " order by lid"
    Set RS = ExecuteSQL(Sql, MsgText)
    Set Grid.DataSource = RS
    
    Printer.FontSize = 11
    Printer.FontBold = True
    Printer.Print "     " & UserNAME & "结帐单"
    Printer.FontBold = False
    Printer.FontSize = 9
    Printer.Print " "
    Printer.Print "流水单号:" & lblCode.Caption

    
     Dim i
    

    For i = 1 To Grid.Rows
        Printer.FontSize = 9
        Printer.Font.Name = "宋体"
        Printer.CurrentX = L1(i - 1).left
        Printer.CurrentY = L1(i - 1).top
        Printer.Print Grid.TextMatrix(i - 1, 1)
        Printer.CurrentX = L2(i - 1).left
        Printer.CurrentY = L2(i - 1).top
        Printer.Print Grid.TextMatrix(i - 1, 2)
        Printer.CurrentX = L3(i - 1).left
        Printer.CurrentY = L3(i - 1).top
        Printer.Print Grid.TextMatrix(i - 1, 3)
        Printer.CurrentX = L4(i - 1).left
        Printer.CurrentY = L4(i - 1).top
        Printer.Print Grid.TextMatrix(i - 1, 4)
        
        
        Load L1(i): Load L2(i): Load L3(i): Load L4(i)
        L1(i).Move L1(i - 1).left, L1(i - 1).top + L1(i - 1).Height + 70
        L2(i).Move L2(i - 1).left, L2(i - 1).top + L2(i - 1).Height + 70
        L3(i).Move L3(i - 1).left, L3(i - 1).top + L3(i - 1).Height + 70
        L4(i).Move L4(i - 1).left, L4(i - 1).top + L4(i - 1).Height + 70
    Next
    Pic1.AutoRedraw = True
    Pic1.AutoSize = True
    Printer.Print " "
    Printer.Print "打印时间:" & Now()
    
    Printer.EndDoc
    Exit Sub
'ErrorPrint:
    'MsgBox Err.Description

End Sub

[bcrun]

呜呜，冤枉啊冤枉。当初你在QQ群中问时，就已经和你说明了的啊，你看你现在的粘贴出来的代码中，那个Collection对象的增减元素使用的参数没配对啊： 你Add时没把第2个参数"键字符串"写进去，Remove时又怎么可能匹配到呢？ 经常有些初学者遇到这方面理解困惑时，希望有人能帮他们把代码改好，并最好尽量以他们能理解的语言解释清楚，但我前段时间忙一个苦闷任务郁闷得很，实在是没时间和心情仔细推敲和修改代码及说明什么的啊 BTW:搞开发经常会焦头烂额的，不要遇到不顺心的就退群啊

IDlist.Add RS1.Fields(0).Value

IDlist.Remove Idx

2013-1-12 16:52:13查看前后消息 前天不是已经告诉你了吗。你说你VB6最基础的Collection的Add,Remove不会用，我说msdn lib里有啊 2013-1-12 16:56:02查看前后消息 你打开msdn lib啊，在“Collection 对象”这个索引条目下，有： Collection 对象关键字总结 作用关键字建立一个Collection对象。Collection添加对象到集合对象中。Add从集合对象中删除对象。Remove引用集合对象中的项。Item 那你还是先在msdn中查collection的帮助打下基础吧，别急着写程序 16:56:36 你要写的至少几千行超市系统，如果你这基础知识都静不下心来看，那么………… 17:23:06 Add 方法的语法具有下列对象限定符和命名参数： 部分 描述 object 必需的。对象表达式，其值为“应用于”列表中的对象。 item 必需的。任意类型的表达式，指定要添加到集合中的成员。 key 可选的。唯一字符串表达式，指定可以使用的键字符串，代替位置索引来访问集合中的成员。