同条件试块养护判定统计表

love3456

    上传一份同条件养护试块统计表，
    这个表格是在论坛诸位大侠提供的素材基础上制作的。
    里面还有很多不足，本人对于VBA编程、函数公式都是不懂得菜鸟级人物。
   只能根据别人的成果一点点抠出来的东西，
   所以请广大成员提出宝贵意见，也希望建筑业的同仁能一起交流。
   如有大侠已做出改进版，望请勿吝啬，上传共享。
   同条件试块统计表（自动抓取天气）.rar (157.74 KB, 下载次数: 209)

2013-9-13 21:51 上传

点击文件名下载附件
同养试块

love3456

欢迎各路高手和建筑业的同仁进行交流。

love3456

这是论坛里另一位朋友做的，VBA加了密码。
求大神帮忙无损破解，或者交流一下源代码。
不是不尊重别人的成果，只是想学习一下。
里面有些东西可以自我改进。

love3456

家园的出的VBA的书籍我已经全部购买，书到了之后努力学习。希望可以和大家一起交流

aails6543

VBA可以移除，看得到里面的代码
Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("目录").Select
End Sub
Sub shiyong()
    MsgBox "首先在天气预报里输入各日期的天气情况、温度等-------然后根据混凝土施工台账在工作表按住CTRL+左键拖动标签（相当于新建工作表）----在工作表工程部位输入当天砼施工记录、在施工日期输入当天日期----下面的资料会自动生成并查找到相对应日期的温度（天气预报里你输入的温度）并自动计算日期----总温度---和平均温度---然后点击返回目录会自动生成该日期的目录及超链接----在月份查询里选择月份----会自动罗列出改查询月份有的日期及资料链接------如有不清楚及问题请联系QQ:2598***8解决", vbQuestion, "混凝土试块测温记录带自动生成目录（确定版）V1.1版本："
End Sub
---------------
Sub GetLinkSheets()
'//生成工作表连接
    Dim i As Integer
    Dim j As Integer
    Dim strsheets As String
    Dim ZStr As String
    On Error Resume Next
    '//
    Application.ScreenUpdating = False
    ZStr = "'"
    For i = 1 To Worksheets.Count                     '//判断 是否有工作表目录
        If Worksheets(i).Name = "目录" Then
            Exit For
        End If
    Next
    If i > Worksheets.Count Then                      '//否则 新建工作表目录
        Sheets.Add
        ActiveSheet.Name = "目录"
    End If
    With Sheets("目录")
        .Move Before:=Sheets(1)                       '//工作表目录移动 保存目录在第一个工作表
        .Select
        Application.EnableEvents = False
        .Range("C5:J200").ClearContents
        j = 5
        For i = 2 To ThisWorkbook.Sheets.Count
            .Hyperlinks.Add Anchor:=.Cells(j, 3), Address:="", SubAddress:=ZStr & Worksheets(i).Name & ZStr & "!A1", TextToDisplay:=Worksheets(i).Name    '//工作表链接
            .Hyperlinks.Add Anchor:=.Cells(j, 5), Address:="", SubAddress:=ZStr & Worksheets(i).Name & ZStr & "!A1", TextToDisplay:=Worksheets(i).Range("c3").Value    '//工作表链接
            j = j + 1
        Next
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End With
End Sub


Sub searchSheet(mymonth As Range)
'//工作表搜索


    Dim i As Integer

    Dim j As Integer

    On Error Resume Next

    j = 6

    With Sheets("目录")

        .Range("A6:A200").Clear

        For i = 3 To Worksheets.Count

            If Month(VBA.CDate(Worksheets(i).Name)) & "月" Like "*" & mymonth & "*" Then '//判断是否与月份相等

                .Hyperlinks.Add Anchor:=.Cells(j, 1), Address:="", SubAddress:=ZStr & Worksheets(i).Name & ZStr & "!A1", TextToDisplay:=Worksheets(i).Name    '//工作表链接

                j = j + 1
            End If

        Next
        
    End With

End Sub
Sub auto_Open()
    MsgBox "文档作者:    克--白快速干道工程  试验室                                                                                                                                                      QQ： 25*****8                               尋找夢想の豬", vbQuestion, "混凝土试块测温记录带自动生成目录（确定版）V1.1版本："
End Sub