search

vieyahn2017 / iBlog

44 stars 0 forks source link

8.21 【VBA】技术贴汇总，以及tips #358

Closed vieyahn2017 closed 3 months ago

vieyahn2017 commented 3 years ago

vba

热处理台账ExcelVBA https://github.com/vieyahn2017/iBlog/issues/298

vieyahn2017 commented 3 years ago

工具ExcelVBA

299

工具ExcelVBA（2）

304

工具ExcelVBA（3）

306

工具ExcelVBA（4）

308

vieyahn2017 commented 3 years ago

ExcelVBA的字典操作 #305


Set defaultDict = CreateObject("Scripting.Dictionary")

defaultDict.Add addKey, defaultVal

Set configDict = CreateObject("Scripting.Dictionary")

    k = configDict.keys
    v = configDict.Items
    For i = 0 To configDict.Count - 1
        content = content & k(i) & "=" & v(i) & vbCrLf
    Next

    ' 导出文件 编码类型为 utf-8 without bom
    Dim filename As String
    filename = ThisWorkbook.Path & "\install_conf.sh"

    WriteUtf8WithoutBom filename, content

    MsgBox "导出到配置文件'" & filename & "'"

Function CheckRequiredParams()

    errMsg = ""
    keys = configDict.keys
    For i = 0 To configDict.Count - 1
        k = keys(i)
        v = Trim(configDict(k))

        If v = "" Then

           ' 先查看有没有默认值，有就用直接用默认值
           If defaultDict.Exists(k) Then
               configDict(k) = defaultDict(k)

           ' 没有默认值，再判断该参数是不是允许为空
           ElseIf nullTipDict.Exists(k) And nullTipDict(k) <> "OK" Then
               errMsg = nullTipDict(k)
               Exit For
           End If

        End If
    Next

    CheckRequiredParams = errMsg

End Function
vieyahn2017 commented 3 years ago

ExcelVBA使用正则表达式 #299 尾部


Function GetStr(rng As Range)
    With CreateObject("VBscript.regexp")
        .Global = True
        .Pattern = "\d+\*\d+\+{0,1}\d{0,}"    '表达式
        If .Execute(rng).Count = 0 Then
            GetStr = ""
        Else
            GetStr = .Execute(rng)(0)
        End If
    End With
End Function

Private Function isIpFormat(ipAddress) As Boolean

    isIpFormat = True

    If Trim(ipAddress) = "" Then
        isIpFormat = False   '''排空
        Exit Function
    End If

    numArr = Split(Trim(ipAddress), ".")
    arrLen = UBound(numArr) - LBound(numArr) + 1

    If arrLen <> 4 Then
        isIpFormat = False
        Exit Function
    End If

    Set ipAddrFormat = CreateObject("VBscript.regexp")
    ipAddrFormat.Pattern = "^[0-9.]+$"
    ipAddrFormat.IgnoreCase = True

    Set regRes = ipAddrFormat.Execute(ipAddress)
    If regRes.Count < 1 Then
        isIpFormat = False
        Exit Function
    End If

    For Each num In numArr
        If Trim(num) = "" Then
            isIpFormat = False
            Exit Function
        End If

        If Trim(num) < 0 Or Trim(num) > 255 Then
            isIpFormat = False
            Exit Function
        End If
    Next
End Function
vieyahn2017 commented 3 years ago

EXCEL查询某数值最后一次出现的行数。

=LOOKUP(1,0/((A1:A99="目标值")*(A1:A99<>"")),ROW(1:99))

vieyahn2017 commented 3 years ago

原来Range对象如果使用Cells的话，它不会自动约束Cells所在的Sheet，在跨Sheet操作时，要么先Select相应的Sheet，要么指定Cells所属的Sheet，否者Range所属Sheet和Cells所属Sheet不一致就会出现1004错误。

https://blog.csdn.net/kobayasi/article/details/6524034

vieyahn2017 commented 3 years ago

vba中MsgBox的参数及用法

https://www.cnblogs.com/mq0036/p/6169957.html

我的示例代码


Public Sub ResetObjectValues()

    g_sheet_Object = Sheets("Config").Cells(6, 1).Value

    ' 清空内容 【通用部分】

    With Sheets(g_sheet_Object)

        startIndex = 3
        endIndex = .UsedRange.Rows.Count
        For RowIndex = startIndex To endIndex
            '第二列， 是否下拉项： 0-否  1-下拉单选项 2-下拉多选项  3-特殊（比如三级下拉的行政区划） 【下拉选从Config那边取值】
            keyType = .Cells(RowIndex, 2).Value

            If keyType = 2 Then
                .Cells(RowIndex, 5).Value = "请选择"
            Else
                .Cells(RowIndex, 5).Value = ""
            End If
        Next

    End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If ActiveCell.Column = 7 And ActiveCell.Row = 2 Then  ' 重填
        result = MsgBox("确定清空已填写内容？", vbOKCancel)
        If result = vbOK Then ResetObjectValues
        Exit Sub
    End If

End Sub
vieyahn2017 commented 3 years ago

【已解决】如何做excel表的下拉框多选

https://blog.csdn.net/qq_42431881/article/details/83786644

要ActiveX控件的listbox

ListFillRange 定义一个名称管理器（这边引用该名称） ListStyle 选择 1 - fmListStyleOption MultiSelect 选择 1 - fmMultiSelectMulti

控制的代码


Private Sub ListBox1_Change()
    'If ReLoad Then Exit Sub '见下方说明
    s = ""
    For i = 0 To ListBox1.ListCount - 1
       If ListBox1.Selected(i) = True Then s = s & "/" & ListBox1.List(i)
    Next
    ActiveCell = Mid(s, 2)  '去掉最前面的/

    If ActiveCell = "" Then
        ActiveCell = "请选择"
    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'listbox显示的目标单元格
    If ActiveCell.Column = 5 And ActiveCell.Row = 15 Then
        t = ActiveCell.Value

        With ListBox1
            For i = 0 To .ListCount - 1 '根据活动单元格内容修改列表框中被选中的内容

                If InStr(t, .List(i)) Then
                    .Selected(i) = True
                Else
                    .Selected(i) = False
                End If
            Next
            'ReLoad = False
            .Top = ActiveCell.Top + ActiveCell.Height '以下语句根据活动单元格位置显示列表框
            .Left = ActiveCell.Left
            .width = ActiveCell.width
            .Visible = True
        End With

        End If

End Sub

该帖子中区别的是： 增加了开关控制，我没测这个功能 模块1中的代码： Public ReLoad As Boolean '开关listbox的change事件

vieyahn2017 commented 3 years ago

hyperlink的使用

公式：

=HYPERLINK("#'" & Config!A6 & "'!A1", Config!A6)