ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南

[求助] 这段VBA联想输入问题、查询代码哪里有问题

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-23 20:52 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
YZC51 发表于 2020-2-23 17:21
会员信息表工作表事件
Private Sub Worksheet_Activate()
    Call Sheet2.汇总统计

老师我代码是这样的,没有自动做统计,请老师指教
Private Sub Worksheet_Activate()
Call Sheet2.汇总统计
Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.Range("a3:a" & Sheet1.[a65536].End(3).Row)
    ReDim brr(1 To UBound(arr), 1 To 3)
    For i = 1 To UBound(arr)
        d(arr(i, 1)) = i
    Next
    crr = Sheet2.Range("a6:j" & Sheet2.[a65536].End(3).Row)
    For i = 1 To UBound(crr)
        n = d(crr(i, 2))
        If n > 0 Then
            If crr(i, 9) > 0 Then brr(n, 1) = brr(n, 1) + crr(i, 9)
            If crr(i, 10) > 0 Then
                brr(n, 2) = brr(n, 2) + crr(i, 10)
                brr(n, 3) = brr(n, 1) - brr(n, 2)
            End If
        End If
    Next
    Sheet1.[e3].Resize(UBound(brr), 3) = brr
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-23 21:03 | 显示全部楼层
本帖最后由 深秋红叶2019 于 2020-2-23 21:09 编辑
YZC51 发表于 2020-2-23 17:27
窗体加载只能是
Private Sub UserForm_Initialize()

原来是这样啊,老师那我这个学习课程代码下拉菜单代码为什么会这样呢,帮我看下哪里有问题,谢谢老师Private Sub UserForm_Initialize()
返学费.List = Array("返学费")
Dim num As Integer
num = ThisWorkbook.Sheets(2).Range("A1").CurrentRegion.Rows.Count          工作表2A列就是做下拉菜单的数据,不知道怎么跑到工作表3去了
Dim Names As Variant
Names = ThisWorkbook.Sheets(2).Range("A2:A" & num).Value
学习课程.List = Names
Label8.Caption = Format(Now, "yyyy年mm月dd日 [$-804]aaaa hh:mm:ss")
Start_Timer
Dim hWndForm As Long
  Dim IStyle As Long
  hWndForm = FindWindow("ThunderDFrame", Me.Caption)
  IStyle = GetWindowLong(hWndForm, GWL_STYLE)
  IStyle = IStyle Or WS_THICKFRAME '还原
  IStyle = IStyle Or WS_MINIMIZEBOX '最小化
  SetWindowLong hWndForm, GWL_STYLE, IStyle
End Sub

6.PNG
7.PNG
8.PNG

TA的精华主题

TA的得分主题

发表于 2020-2-23 21:42 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
深秋红叶2019 发表于 2020-2-23 21:03
原来是这样啊,老师那我这个学习课程代码下拉菜单代码为什么会这样呢,帮我看下哪里有问题,谢谢老师:lov ...

您总是变来变去,让人很难适应!!!
Private Sub UserForm_Initialize()
    返学费.List = Array("返学费")
    Label8.Caption = Format(Now, "yyyy年mm月dd日") & Chr(10) & Format(Now, "aaahh:mm:ss")
    Dim num As Integer
    Dim Names As Variant
    'num = Sheet2.Range("A1").CurrentRegion.Rows.Count
    num = Sheet2.[a65536].End(3).Row
   
    Names = Sheet2.Range("A2:A" & num).Value
    学习课程.List = Names
    学习课程.ListIndex = 1
    学习课程.ListRows = num - 1
   
    Dim hWndForm As Long
    Dim IStyle As Long
    hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    IStyle = GetWindowLong(hWndForm, GWL_STYLE)
    IStyle = IStyle Or WS_THICKFRAME '还原
    IStyle = IStyle Or WS_MINIMIZEBOX '最小化
    SetWindowLong hWndForm, GWL_STYLE, IStyle
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-23 21:57 | 显示全部楼层
YZC51 发表于 2020-2-23 21:42
您总是变来变去,让人很难适应!!!
Private Sub UserForm_Initialize()
    返学费.List = Array("返 ...

因为这里有两个系统,一个是美业收银,另一个是学员报名系统,我是从一个系统里的代码挪到了另一个系统去实现,所以遇到了问题

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-24 23:29 | 显示全部楼层
YZC51 发表于 2020-2-23 15:31
74楼附件已经更新,请重新下载!

老师发现保存修改按钮没有用,我改了一下123号码的性别发现没改到,我现在才发现,请老师看一下问题,谢谢啦
Private Sub CommandButton3_Click() '修改电话卡号
     Sheet1.Range("A" & hh) = Me.电话卡号
'     Unload Me
MsgBox "修改会员信息成功!!!", 48, "温馨提示……"
End Sub

1.PNG
2.PNG

蓝泰美业收银系统.zip

63.14 KB, 下载次数: 4

TA的精华主题

TA的得分主题

发表于 2020-2-25 01:39 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
深秋红叶2019 发表于 2020-2-24 23:29
老师发现保存修改按钮没有用,我改了一下123号码的性别发现没改到,我现在才发现,请老师看一下问题,谢 ...

请参考
Private Sub CommandButton3_Click() '修改电话卡号
    Sheet1.Range("A" & hh) = Me.电话卡号
    Sheet1.Range("B" & hh) = Me.会员姓名
    Sheet1.Range("C" & hh) = Me.性别
    Sheet1.Range("D" & hh) = Me.卡类型
    MsgBox "修改会员信息成功!!!", 48, "温馨提示……"
'   Unload Me
End Sub

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-25 19:29 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
YZC51 发表于 2020-2-25 01:39
请参考
Private Sub CommandButton3_Click() '修改电话卡号
    Sheet1.Range("A" & hh) = Me.电话卡号 ...

老师像这种不是以查询条件的应该怎么保存修改呢
Dim hh
---------------------------------------------------------
Private Sub CommandButton9_Click() '修改
     Sheet3.Range("B" & hh) = Me.学员电话
     Sheet3.Range("J" & hh) = Me.课程名称
     Sheet3.Range("K" & hh) = Me.实缴学费
     Sheet3.Range("L" & hh) = Me.返学费

'     Unload Me
MsgBox "修改报名信息成功!!!", 48, "温馨提示……"
End Sub


2.PNG
3.PNG

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-25 19:47 | 显示全部楼层
YZC51 发表于 2020-2-25 01:39
请参考
Private Sub CommandButton3_Click() '修改电话卡号
    Sheet1.Range("A" & hh) = Me.电话卡号 ...

老师,这段删除记录的代码为什么会这样呢,我把124号码找到然后点击删除就变成图2了Private Sub CommandButton8_Click() '删除
Dim n As Integer, i As Integer
    For n = 3 To Sheet1.Range("a65536").End(xlUp).Row
      If 学员电话.Text = Sheet1.Range("a" & n) Then Exit For
        Next n
          If MsgBox("是否真的删除数据", vbYesNo) = vbYes Then Sheet1.Rows(n).Delete
          For i = n To Sheet2.Range("a65536").End(xlUp).Row
              Sheet1.Cells(i, 1) = i - 1
          Next i
      End
End Sub

4.PNG
5.PNG

TA的精华主题

TA的得分主题

发表于 2020-2-26 16:06 | 显示全部楼层
本帖最后由 YZC51 于 2020-2-28 17:50 编辑
深秋红叶2019 发表于 2020-2-25 19:47
老师,这段删除记录的代码为什么会这样呢,我把124号码找到然后点击删除就变成图2了Private Sub CommandB ...

请参考
CommandButton8_Click() '删除
Dim n As Integer, i As Integer
    For n = 3 To Sheet1.Range("a65536").End(xlUp).Row
      If 学员电话.Text = Sheet1.Range("b" & n) Then Exit For
    Next n
          If MsgBox("是否真的删除数据", vbYesNo) = vbYes Then Sheet1.Rows(n).Delete
      End
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-2-29 10:45 | 显示全部楼层
深秋红叶2019 发表于 2020-2-25 19:47
老师,这段删除记录的代码为什么会这样呢,我把124号码找到然后点击删除就变成图2了Private Sub CommandB ...

楼主好!楼上的代码您测试过没有!
能用否,请给个回复!!!

评分

2

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 19:30 , Processed in 0.073226 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表