吾爱破解 - LCG - LSG |安卓破解|病毒分析|www.52pojie.cn

 找回密码
 注册[Register]

QQ登录

只需一步,快速开始

查看: 2584|回复: 24
收起左侧

[其他原创] Excel实现大乐透历史查询【更新】

[复制链接]
wloves520 发表于 2023-10-10 17:02
本帖最后由 wloves520 于 2023-10-17 11:00 编辑

功能:可查询07年至今是否开过这串号码。(更新)
界面更新:
2.png

下载地址: 大乐透查询是否中过奖v1017.rar (146.83 KB, 下载次数: 153)

代码更新:
[Visual Basic] 纯文本查看 复制代码
Function FormatNumber(num As String) As String
    ' 这个函数用于将数字格式化为两位数,不足两位的在前面补零
    FormatNumber = Right("00" & num, 2)
End Function

Sub QueryFrontArea()
    ' 查询前区的子过程
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim num1 As String, num2 As String, num3 As String, num4 As String, num5 As String
    Dim i As Integer
    
    ' 设置要操作的两个工作表
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("查询")
    
    ' 从查询表中获取前区的数字,并不做格式化处理
    num1 = ws2.Range("C3").Value
    num2 = ws2.Range("D3").Value
    num3 = ws2.Range("E3").Value
    num4 = ws2.Range("F3").Value
    num5 = ws2.Range("G3").Value
    
    ' 循环遍历数据表中的每一行
    For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        ' 判断前区的数字是否匹配
        If ws1.Cells(i, 3).Value = num1 And ws1.Cells(i, 4).Value = num2 And ws1.Cells(i, 5).Value = num3 And ws1.Cells(i, 6).Value = num4 And ws1.Cells(i, 7).Value = num5 Then
            ' 如果匹配,则将对应的信息写入查询表中的指定单元格
            ws2.Range("E5").Value = ws1.Cells(i, 1).Value
            ws2.Range("E6").Value = ws1.Cells(i, 2).Value
            Exit Sub ' 已经找到匹配,可以退出循环了
        End If
    Next i
    
    ' 如果循环结束还没有匹配到,就写入未查询到的提示信息
    ws2.Range("E5").Value = "未查询到前区"
    ws2.Range("E6").Value = "未查询到前区"
End Sub

Sub QueryAll()
    ' 查询所有的子过程
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim num1 As String, num2 As String, num3 As String, num4 As String, num5 As String, num6 As String, num7 As String
    Dim i As Integer
    
    ' 设置要操作的两个工作表
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("查询")
    
    ' 从查询表中获取所有的数字,并不做格式化处理
    num1 = ws2.Range("C3").Value
    num2 = ws2.Range("D3").Value
    num3 = ws2.Range("E3").Value
    num4 = ws2.Range("F3").Value
    num5 = ws2.Range("G3").Value
    num6 = ws2.Range("H3").Value
    num7 = ws2.Range("I3").Value
    
    ' 循环遍历数据表中的每一行
    For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        ' 判断所有数字是否匹配
        If ws1.Cells(i, 3).Value = num1 And ws1.Cells(i, 4).Value = num2 And ws1.Cells(i, 5).Value = num3 And ws1.Cells(i, 6).Value = num4 And ws1.Cells(i, 7).Value = num5 And ws1.Cells(i, 8).Value = num6 And ws1.Cells(i, 9).Value = num7 Then
            ' 如果匹配,则将对应的信息写入查询表中的指定单元格
            ws2.Range("E5").Value = ws1.Cells(i, 1).Value
            ws2.Range("E6").Value = ws1.Cells(i, 2).Value
            Exit Sub ' 已经找到匹配,可以退出循环了
        End If
    Next i
    
    ' 如果循环结束还没有匹配到,就写入未查询到的提示信息
    ws2.Range("E5").Value = "未查询到"
    ws2.Range("E6").Value = "未查询到"
End Sub


Sub QueryFrontThree()
    ' 查询前三位的子过程
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim num1 As String, num2 As String, num3 As String
    Dim i As Integer
    Dim result As String
    
    ' 设置要操作的两个工作表
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("查询")
    
    ' 从查询表中获取前三位的数字,并不做格式化处理
    num1 = ws2.Range("C3").Value
    num2 = ws2.Range("D3").Value
    num3 = ws2.Range("E3").Value
    
    ' 初始化查询结果为空字符串
    result = ""
    
    ' 循环遍历数据表中的每一行
    For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        ' 判断前三位的数字是否匹配
        If ws1.Cells(i, 3).Value = num1 And ws1.Cells(i, 4).Value = num2 And ws1.Cells(i, 5).Value = num3 Then
            ' 如果匹配,则将对应的信息添加到查询结果中
            If result = "" Then
                result = ws1.Cells(i, 1).Value & " - " & ws1.Cells(i, 2).Value
            Else
                result = result & ", " & ws1.Cells(i, 1).Value & " - " & ws1.Cells(i, 2).Value
            End If
        End If
    Next i
    
    ' 将查询结果写入查询表中的指定单元格
    ws2.Range("C7").Value = result
    If result = "" Then
        ws2.Range("D7").Value = "未查询到前三位中奖"
    Else
        ws2.Range("D7").Value = ""
    End If
End Sub

Sub QueryFrontFour()
    ' 查询前四位的子过程
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim num1 As String, num2 As String, num3 As String, num4 As String
    Dim i As Integer
    Dim result As String
    
    ' 设置要操作的两个工作表
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("查询")
    
    ' 从查询表中获取前四位的数字,并不做格式化处理
    num1 = ws2.Range("C3").Value
    num2 = ws2.Range("D3").Value
    num3 = ws2.Range("E3").Value
    num4 = ws2.Range("F3").Value

    
    ' 初始化查询结果为空字符串
    result = ""
    
    ' 循环遍历数据表中的每一行
    For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        ' 判断前四位的数字是否匹配
        If ws1.Cells(i, 3).Value = num1 And ws1.Cells(i, 4).Value = num2 And ws1.Cells(i, 5).Value = num3 And ws1.Cells(i, 6).Value = num4 Then
            ' 如果匹配,则将对应的信息添加到查询结果中
            If result = "" Then
                result = ws1.Cells(i, 1).Value & " - " & ws1.Cells(i, 2).Value
            Else
                result = result & ", " & ws1.Cells(i, 1).Value & " - " & ws1.Cells(i, 2).Value
            End If
        End If
    Next i
    
    ' 将查询结果写入查询表中的指定单元格
    ws2.Range("C8").Value = result
    If result = "" Then
        ws2.Range("D8").Value = "未查询到前四位中奖"
    Else
        ws2.Range("D8").Value = ""
    End If
End Sub




以下是上一个版本(旧版)

界面:
微信截图_20231010165708.png
说明:采用vba编写,需要运行宏,属于源在Sheet1中,后续如果大乐透官网有更新新的,可以自行更新,粘贴进去就可以了。

旧版下载地址: 大乐透查询是否中过奖.rar (126.77 KB, 下载次数: 118)

旧版源码:
[Visual Basic] 纯文本查看 复制代码
Function FormatNumber(num As String) As String
    ' 这是一个自定义的函数,用于格式化输入的数字。
    ' 它将输入的数字转化为两位数的字符串形式,并返回结果。
    FormatNumber = Right("00" & num, 2)
End Function

Sub QueryFrontArea()
    ' 声明变量
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim num1 As String, num2 As String, num3 As String, num4 As String, num5 As String
    Dim i As Integer

    ' 设置变量
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("查询")

    ' 使用FormatNumber函数对单元格的值进行格式化
    num1 = FormatNumber(ws2.Range("C3").Value)
    num2 = FormatNumber(ws2.Range("D3").Value)
    num3 = FormatNumber(ws2.Range("E3").Value)
    num4 = FormatNumber(ws2.Range("F3").Value)
    num5 = FormatNumber(ws2.Range("G3").Value)

    ' 循环遍历Sheet1中的数据
    For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        ' 检查条件是否满足
        If ws1.Cells(i, 3).Value = num1 And ws1.Cells(i, 4).Value = num2 And ws1.Cells(i, 5).Value = num3 And ws1.Cells(i, 6).Value = num4 And ws1.Cells(i, 7).Value = num5 Then
            ' 如果条件满足,则将Sheet1中对应行的第一个单元格的值复制到查询Sheet的C4单元格
            ws2.Range("C4").Value = ws1.Cells(i, 1).Value
            ' 退出子程序
            Exit Sub
        End If
    Next i

    ' 如果未找到匹配的数据,将 "未查询到前区" 写入查询Sheet的C4单元格
    ws2.Range("C4").Value = "未查询到前区"
End Sub

Sub QueryAll()
    ' 声明变量
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim num1 As String, num2 As String, num3 As String, num4 As String, num5 As String, num6 As String, num7 As String
    Dim i As Integer

    ' 设置变量
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("查询")

    ' 使用FormatNumber函数对单元格的值进行格式化
    num1 = FormatNumber(ws2.Range("C3").Value)
    num2 = FormatNumber(ws2.Range("D3").Value)
    num3 = FormatNumber(ws2.Range("E3").Value)
    num4 = FormatNumber(ws2.Range("F3").Value)
    num5 = FormatNumber(ws2.Range("G3").Value)
    num6 = FormatNumber(ws2.Range("H3").Value)
    num7 = FormatNumber(ws2.Range("I3").Value)

    ' 循环遍历Sheet1中的数据
    For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        ' 检查条件是否满足
        If ws1.Cells(i, 3).Value = num1 And ws1.Cells(i, 4).Value = num2 And ws1.Cells(i, 5).Value = num3 And ws1.Cells(i, 6).Value = num4 And ws1.Cells(i, 7).Value = num5 And ws1.Cells(i, 8).Value = num6 And ws1.Cells(i, 9).Value = num7 Then
            ' 如果条件满足,则将Sheet1中对应行的第一个单元格的值复制到查询Sheet的C4单元格
            ws2.Range("C4").Value = ws1.Cells(i, 1).Value
            ' 退出子程序
            Exit Sub
        End If
    Next i

    ' 如果未找到匹配的数据,将 "未查询到" 写入查询Sheet的C4单元格
    ws2.Range("C4").Value = "未查询到"
End Sub

Private Sub CommandButton1_Click()
    ' 当CommandButton1被点击时,调用QueryFrontArea子程序
    Call QueryFrontArea
End Sub

Private Sub CommandButton2_Click()
    ' 当CommandButton2被点击时,调用QueryAll子程序
    Call QueryAll
End Sub

免费评分

参与人数 7吾爱币 +11 热心值 +7 收起 理由
xingzai + 1 + 1 谢谢@Thanks!
junjia215 + 1 + 1 用心讨论,共获提升!
苏紫方璇 + 7 + 1 欢迎分析讨论交流,吾爱破解论坛有你更精彩!
改变世界 + 1 + 1 我很赞同!
小哥仔 + 1 热心回复!
不会上树的鱼 + 1 + 1 谢谢@Thanks!
QaQ355 + 1 热心回复!

查看全部评分

本帖被以下淘专辑推荐:

发帖前要善用论坛搜索功能,那里可能会有你要找的答案或者已经有人发布过相同内容了,请勿重复发帖。

 楼主| wloves520 发表于 2023-10-17 10:07
TinaZerotwo 发表于 2023-10-15 11:24
建议添加注释来描述代码的功能和逻辑,并使用有意义的变量名和子程序名

[Visual Basic] 纯文本查看 复制代码
Function FormatNumber(num As String) As String
    ' 这是一个自定义的函数,用于格式化输入的数字。
    ' 它将输入的数字转化为两位数的字符串形式,并返回结果。
    FormatNumber = Right("00" & num, 2)
End Function

Sub QueryFrontArea()
    ' 声明变量
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim num1 As String, num2 As String, num3 As String, num4 As String, num5 As String
    Dim i As Integer

    ' 设置变量
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("查询")

    ' 使用FormatNumber函数对单元格的值进行格式化
    num1 = FormatNumber(ws2.Range("C3").Value)
    num2 = FormatNumber(ws2.Range("D3").Value)
    num3 = FormatNumber(ws2.Range("E3").Value)
    num4 = FormatNumber(ws2.Range("F3").Value)
    num5 = FormatNumber(ws2.Range("G3").Value)

    ' 循环遍历Sheet1中的数据
    For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        ' 检查条件是否满足
        If ws1.Cells(i, 3).Value = num1 And ws1.Cells(i, 4).Value = num2 And ws1.Cells(i, 5).Value = num3 And ws1.Cells(i, 6).Value = num4 And ws1.Cells(i, 7).Value = num5 Then
            ' 如果条件满足,则将Sheet1中对应行的第一个单元格的值复制到查询Sheet的C4单元格
            ws2.Range("C4").Value = ws1.Cells(i, 1).Value
            ' 退出子程序
            Exit Sub
        End If
    Next i

    ' 如果未找到匹配的数据,将 "未查询到前区" 写入查询Sheet的C4单元格
    ws2.Range("C4").Value = "未查询到前区"
End Sub

Sub QueryAll()
    ' 声明变量
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim num1 As String, num2 As String, num3 As String, num4 As String, num5 As String, num6 As String, num7 As String
    Dim i As Integer

    ' 设置变量
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("查询")

    ' 使用FormatNumber函数对单元格的值进行格式化
    num1 = FormatNumber(ws2.Range("C3").Value)
    num2 = FormatNumber(ws2.Range("D3").Value)
    num3 = FormatNumber(ws2.Range("E3").Value)
    num4 = FormatNumber(ws2.Range("F3").Value)
    num5 = FormatNumber(ws2.Range("G3").Value)
    num6 = FormatNumber(ws2.Range("H3").Value)
    num7 = FormatNumber(ws2.Range("I3").Value)

    ' 循环遍历Sheet1中的数据
    For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        ' 检查条件是否满足
        If ws1.Cells(i, 3).Value = num1 And ws1.Cells(i, 4).Value = num2 And ws1.Cells(i, 5).Value = num3 And ws1.Cells(i, 6).Value = num4 And ws1.Cells(i, 7).Value = num5 And ws1.Cells(i, 8).Value = num6 And ws1.Cells(i, 9).Value = num7 Then
            ' 如果条件满足,则将Sheet1中对应行的第一个单元格的值复制到查询Sheet的C4单元格
            ws2.Range("C4").Value = ws1.Cells(i, 1).Value
            ' 退出子程序
            Exit Sub
        End If
    Next i

    ' 如果未找到匹配的数据,将 "未查询到" 写入查询Sheet的C4单元格
    ws2.Range("C4").Value = "未查询到"
End Sub

Private Sub CommandButton1_Click()
    ' 当CommandButton1被点击时,调用QueryFrontArea子程序
    Call QueryFrontArea
End Sub

Private Sub CommandButton2_Click()
    ' 当CommandButton2被点击时,调用QueryAll子程序
    Call QueryAll
End Sub



这些代码一起实现了以下功能:

FormatNumber 是一个自定义函数,将输入的数字转化为两位数的字符串形式。
QueryFrontArea 子程序在Sheet1中搜索与查询Sheet中特定单元格(C3到G3)值匹配的行,并将Sheet1中对应行的第一个单元格的值复制到查询Sheet的C4单元格。如果未找到匹配的数据,将 "未查询到前区" 写入查询Sheet的C4单元格。
QueryAll 子程序在Sheet1中搜索与查询Sheet中特定单元格(C3到I3)值匹配的行,并将Sheet1中对应行的第一个单元格的值复制到查询Sheet的C4单元格。如果未找到匹配的数据,将 "未查询到" 写入查询Sheet的C4单元格。
CommandButton1_Click 和 CommandButton2_Click 是两个按钮的点击事件处理程序,分别调用 QueryFrontArea 和 QueryAll 子程序。
请注意,这些代码的具体功能依赖于你的Excel工作簿的结构和数据。
苏紫方璇 发表于 2023-10-15 23:32
推荐使用此方法进行代码插入,本贴已帮你修改
【公告】发帖代码插入以及添加链接教程(有福利)
https://www.52pojie.cn/thread-713042-1-1.html
(出处: 吾爱破解论坛)
不会上树的鱼 发表于 2023-10-10 18:11
头像被屏蔽
zrj2019 发表于 2023-10-10 19:43
提示: 该帖被管理员或版主屏蔽
jacker 发表于 2023-10-10 20:18
  感谢楼主分享。
erdsyccw 发表于 2023-10-10 20:41
下来试试
moruye 发表于 2023-10-10 20:56
这个可以捣鼓捣鼓
hhbob23 发表于 2023-10-10 23:31
谢谢,麻烦再来个双色球的
jxd728 发表于 2023-10-11 08:51
学习学习
yu520 发表于 2023-10-11 09:13
这是查询啥,不是太懂
10jr4 发表于 2023-10-11 11:59

学习学习
您需要登录后才可以回帖 登录 | 注册[Register]

本版积分规则 警告:本版块禁止灌水或回复与主题无关内容,违者重罚!

快速回复 收藏帖子 返回列表 搜索

RSS订阅|小黑屋|处罚记录|联系我们|吾爱破解 - LCG - LSG ( 京ICP备16042023号 | 京公网安备 11010502030087号 )

GMT+8, 2024-4-29 05:28

Powered by Discuz!

Copyright © 2001-2020, Tencent Cloud.

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