日期窗体问题和模糊查找

绿色心情小天使 · 发表于 2025-4-13 10:54

大家末有E友好：
下表为在第二列日期窗体，日期窗体已做在里，单击单元格运行错误。
产品窗体已做在里面在，模糊查找（数据来源“记录表”），模糊查找字段:车间、负责人、物料编码、品名、规格中模糊查找到的结果显示在窗体列表中。
附件如下。
不胜E友的大神赐教，TKS！

0413（查找）.rar (37.72 KB, 下载次数: 13)

温馨云 · 发表于 2025-4-13 12:43

换个日期窗体，你那个日期窗体有个bindBuntonModule模块没复制过来，还有个buttonEvent类模块没复制过来，当然会出错。这个日期窗体没写好，点击后不会把值写到单元格，建议换一个。
模糊查找，是查找sheet3,代码里改成记录表即可。

quqiyuan · 发表于 2025-4-13 13:28

本帖最后由 quqiyuan 于 2025-4-13 13:29 编辑

以前备份了opiona兄弟的日历控件，借花献佛，查询改了sheet即可

quqiyuan · 发表于 2025-4-13 13:29

代码如下。。。
Public PubSelDate As Date    '//代表已经选择的日期

Option Explicit  '//强制声明变量

Rem ================================================================================================================农历常量
Rem 公历转农历模块

Rem // 农历数据定义 //
Rem 先以 H2B 函数还原成长度为 18 的字符串，其定义如下：
Rem 前12个字节代表1-12月：1为大月，0为小月；压缩成十六进制(1-3位)
Rem 第13位为闰月的情况，1为大月30天，0为小月29天；(4位)
Rem 第14位为闰月的月份，如果不是闰月为0，否则给出月份(5位)
Rem 最后4位为当年农历新年的公历日期，如0131代表1月31日；当作数值转十六进制(6-7位)

Rem 农历常量(1899~2100，共202年）
Private Const ylData = "AB500D2,4BD0883," _
& "4AE00DB,A5700D0,54D0581,D2600D8,D9500CC,655147D,56A00D5,9AD00CA,55D027A,4AE00D2," _
& "A5B0682,A4D00DA,D2500CE,D25157E,B5500D6,56A00CC,ADA027B,95B00D3,49717C9,49B00DC," _
& "A4B00D0,B4B0580,6A500D8,6D400CD,AB5147C,2B600D5,95700CA,52F027B,49700D2,6560682," _
& "D4A00D9,EA500CE,6A9157E,5AD00D6,2B600CC,86E137C,92E00D3,C8D1783,C9500DB,D4A00D0," _
& "D8A167F,B5500D7,56A00CD,A5B147D,25D00D5,92D00CA,D2B027A,A9500D2,B550781,6CA00D9," _
& "B5500CE,535157F,4DA00D6,A5B00CB,457037C,52B00D4,A9A0883,E9500DA,6AA00D0,AEA0680," _
& "AB500D7,4B600CD,AAE047D,A5700D5,52600CA,F260379,D9500D1,5B50782,56A00D9,96D00CE," _
& "4DD057F,4AD00D7,A4D00CB,D4D047B,D2500D3,D550883,B5400DA,B6A00CF,95A1680,95B00D8," _
& "49B00CD,A97047D,A4B00D5,B270ACA,6A500DC,6D400D1,AF40681,AB600D9,93700CE,4AF057F," _
& "49700D7,64B00CC,74A037B,EA500D2,6B50883,5AC00DB,AB600CF,96D0580,92E00D8,C9600CD," _
& "D95047C,D4A00D4,DA500C9,755027A,56A00D1,ABB0781,25D00DA,92D00CF,CAB057E,A9500D6," _
& "B4A00CB,BAA047B,B5500D2,55D0983,4BA00DB,A5B00D0,5171680,52B00D8,A9300CD,795047D," _
& "6AA00D4,AD500C9,5B5027A,4B600D2,96E0681,A4E00D9,D2600CE,EA6057E,D5300D5,5AA00CB," _
& "76A037B,96D00D3,4AB0B83,4AD00DB,A4D00D0,D0B1680,D2500D7,D5200CC,DD4057C,B5A00D4," _
& "56D00C9,55B027A,49B00D2,A570782,A4B00D9,AA500CE,B25157E,6D200D6,ADA00CA,4B6137B," _
& "93700D3,49F08C9,49700DB,64B00D0,68A1680,EA500D7,6AA00CC,A6C147C,AAE00D4,92E00CA," _
& "D2E0379,C9600D1,D550781,D4A00D9,DA400CD,5D5057E,56A00D6,A6C00CB,55D047B,52D00D3," _
& "A9B0883,A9500DB,B4A00CF,B6A067F,AD500D7,55A00CD,ABA047C,A5A00D4,52B00CA,B27037A," _
& "69300D1,7330781,6AA00D9,AD500CE,4B5157E,4B600D6,A5700CB,54E047C,D1600D2,E960882," _
& "D5200DA,DAA00CF,6AA167F,56D00D7,4AE00CD,A9D047D,A2D00D4,D1500C9,F250279,D5200D1"

Private Const ylMd0 = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五" _
& "十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十 "

Private Const ylMn0 = "正二三四五六七八九十冬腊"
Private Const ylTianGan0 = "甲乙丙丁戊已庚辛壬癸"
Private Const ylDiZhi0 = "子丑寅卯辰巳午未申酉戌亥"
Private Const ylShu0 = "鼠牛虎兔龙蛇马羊猴鸡狗猪"

Rem ================================================================================================================窗体变量
Public youXuan As Boolean
Private cmdDay
Private strZuo As String
Private strJin As String

Rem 窗体常数
Const Min_Year = 1901
Const Max_Year = 2099
Const Min_Month = 1
Const Max_Month = 12
Const Str_Fen = "-"

Const Color_Sunday = &HFF&             '//红色 '//星期六日颜色
Const Color_GrayWeekday = &H0&          '//黑色 '//非本月非星期六日颜色
Const Color_DayBackNoMonth = &H8000000F '//灰色 '//非本月日期底色

Const Color_Weekday = &HFF0000          '//蓝色 '//本月非星期六日颜色
Const Color_GraySunday = &H8080FF       '//红色 '//星期六日颜色
Const Color_DayBackColor = &H80FF80    '//绿色 '//本月日期底色
Const Color_DayNowBackColor = &HFF80FF '//粉色 '//今天的底色
Const Color_DayNowBackColor1 = &H80FFFF '//黄色 '//被选中日期底色

Rem 颜色： &H808080  '//红色；&HFF0000  '//蓝色

Rem 按钮相应事件

Private Sub cmdDay_Click(strDay As String, nNowMonth As Integer)

Rem Call cmdDay_Click(cmdDay11.Caption, cmdDay11.Tag)
Rem 按钮上的文字，月份差
youXuan = True
Dim dtFirstDate
Dim ln As Long

Rem 选择后：本月第一天
dtFirstDate = Replace(Replace(cmbYear.Text, "年", ""), "月", "") & Str_Fen & Replace(Replace(cmbMonth.Text, "年", ""), "月", "") & Str_Fen & "1"

Rem 计算被选择的是：那个月的那一天
PubSelDate = DateAdd("m", nNowMonth, dtFirstDate)
PubSelDate = CDate(Year(PubSelDate) & Str_Fen & Month(PubSelDate) & Str_Fen & strDay)

Rem 恢复其他控件设置
For ln = 0 To 41                '//遍历所有日期按钮

      Rem 如果选择的日期是本日，则此按钮被选中
      If cmdDay(ln).Caption = strDay And cmdDay(ln).Tag = nNowMonth Then
         cmdDay(ln).SetFocus
         cmdDay(ln).Font.Bold = True
         cmdDay(ln).BackColor = Color_DayNowBackColor1
      Else
         cmdDay(ln).Font.Bold = False '//不是被选择日期，字体正常
         Rem 非本月日期为：灰色
         If cmdDay(ln).Tag <> 0 Then
            cmdDay(ln).BackColor = Color_DayBackNoMonth
         Else
            Rem 如果是系统日，字体加粗，底色
            If Replace(Replace(cmbYear.Text, "年", ""), "月", "") = CStr(Year(Now)) And Replace(Replace(cmbMonth.Text, "年", ""), "月", "") = CStr(Month(Now)) And cmdDay(ln).Caption = CStr(Day(Now)) Then
                  cmdDay(ln).Font.Bold = False
                  cmdDay(ln).BackColor = Color_DayNowBackColor
            Else
                  cmdDay(ln).BackColor = Color_DayBackColor
            End If
         End If
      End If
Next

' If TextFANGSHI.Text = 1 Then
'       PubDateControl.Text = Format(PubSelDate, "yyyy-MM-dd")
' Else
      ActiveCell.Value = Format(PubSelDate, "M月d日")
' End If
Unload Me  '//启用时，去掉注释

End Sub

Private Sub TextFANGSHI_Change()

Rem **********************************************************************************************************使用说明
Rem ***** 单元格调用方法 *******************************************
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
'       If Target.Row > 3 And Target.Row < 8 And Target.Column = 2 Then
'          PubSelDate = Target.Value
'          Frm_Riqi.TextFANGSHI.Text = 0  '//只在工作表中,直接将控件text=0
'          Frm_Riqi.Show
'       End If
' End If
'End Sub

Rem    ***** 窗体中调用方法 *******************************************
'    Public PubSelDate As Date    '//代表已经选择的日期
'    Public PubDateControl As Object  '//代表日期传送到窗体的控件
' Private Sub UserForm_Initialize()
'       Set PubDateControl = Text日期
' End Sub
' Private Sub Text日期_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
'
'       If Len(Text日期.Text) >= 8 Then
'          Rem 如果日期非空白，则显示指定日期
'          PubSelDate = Text日期.Text
'       Else
'          Rem 如果日期空白，则是今天
'          PubSelDate = Date
'       End If
'       Frm_Riqi.Show
' End Sub

Rem    ***** 内置日期函数 *******************************************
Rem 农历和公历假日：GetJiaRi()
Rem 公历日期转农历：GetYLDate()
Rem 农历转公历日期：GetGLDate()
Rem 获得节气： GetJieQi()
End Sub

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Rem 双击
CommToday_Click
End Sub

Private Sub UserForm_Initialize()
Rem 窗体初始化
Rem 初始化全部日期按钮
cmdDay = Array(cmdDay11, cmdDay12, cmdDay13, cmdDay14, cmdDay15, cmdDay16, cmdDay17, cmdDay21, cmdDay22, cmdDay23, cmdDay24, cmdDay25, cmdDay26, cmdDay27, cmdDay31, cmdDay32, cmdDay33, cmdDay34, cmdDay35, cmdDay36, cmdDay37, cmdDay41, cmdDay42, cmdDay43, cmdDay44, cmdDay45, cmdDay46, cmdDay47, cmdDay51, cmdDay52, cmdDay53, cmdDay54, cmdDay55, cmdDay56, cmdDay57, cmdDay61, cmdDay62, cmdDay63, cmdDay64, cmdDay65, cmdDay66, cmdDay67)

Rem 装填年月
Dim ln As Integer
For ln = Min_Year To Max_Year
      cmbYear.AddItem CStr(ln) & "年"
Next
For ln = Min_Month To Max_Month
      cmbMonth.AddItem CStr(ln) & "月"
Next
cmbYear.Text = Year(Now) & "年"
cmbMonth.Text = Month(Now) & "月"

Label1.Caption = "今天是公历 " & Format(Date, "yyyy年m月d日")

Rem 今天或指定日日历
Call CommDiyday_Click
End Sub

温馨云 · 发表于 2025-4-13 18:30

这个是用cidanji老师的极简日历，年份、月分切换用滚轮，很方便。
单元格双击进入窗体应该更合理一些。

0413（查找）_1.zip (58.16 KB, 下载次数: 19)

温馨云 · 发表于 2025-4-13 18:33

原贴：
极简日历
https://club.excelhome.net/thread-1705552-1-1.html
(出处: ExcelHome技术论坛)

温馨云 · 发表于 2025-4-13 18:46

稍微改了一下，鼠标移到月份，滚轮切换月，移到年则切换年。

用户名		自动登录	找回密码
密码			免费注册

[求助] 日期窗体问题和模糊查找

评分

评分

评分

浏览过的版块