Bajins

# VBAScript

# Flag

Office Visual Basic for Applications (VBA)

  • =IF(IFERROR(FIND("不良",B2),0),"不良品仓",IF(IFERROR(FIND("待检",B2),0),"待检仓",IF(IFERROR(FIND("报废",B2),0),"报废仓",IF(IFERROR(FIND("良",B2),0),"良品仓",""))))
  • 匹配单元格左边英文及其他字符=RegexString(A1,"[^\u4e00-\u9fa5]+")
  • 匹配单元格右边中文及其他字符=RegexString(A1,"[\u4e00-\u9fa5].*")
Function RegexString(rng As Range, str As String)
'第一个参数rng为区域保持不变， 添加第二个参数str（作为正则表达式）
  With CreateObject("VBscript.regexp")
    .Global = True
    .Pattern = str '表达式,直接从用户函数的第二个参数中调用
    If .Execute(rng).Count = 0 Then
    RegexString = ""
    Else
    RegexString = .Execute(rng)(0)
    End If
  End With
End Function

复制一大片区域的单元格公式函数，不改变引用变动

  1. 在 文件 A 中，按 Ctrl + ~ （波浪号，通常在 Esc 键下面）进入显示公式模式。
  2. 选中你要复制的所有单元格，Ctrl + C。
  3. 打开 Windows 自带的 记事本 (Notepad)，Ctrl + V 粘贴。
  4. 在记事本里 Ctrl + A 全选，Ctrl + C 复制。
  5. 回到 文件 B，Ctrl + V 粘贴。
  6. 在文件 A 按 Ctrl + ~ 恢复正常显示模式。

向下拉函数计算的值与第一个单元格值一样

如果 Excel 的“计算选项”处于手动计算模式，当你下拉公式时，它不会自动重新计算新的一行，而是直接复制上一行的结果。

  1. 点击 Excel 顶部菜单栏的 “公式” (Formulas) 选项卡。
  2. 找到最右侧的 “计算选项” (Calculation Options)。
  3. 检查是否勾选了 “自动” (Automatic)。
    • 如果是“手动”，请改为“自动”。
    • 或者，你可以按一下键盘上的 F9 键。如果按了之后数值变了，说明就是这个问题。

# 分割字符串并统计

'https://blog.csdn.net/wordsin/article/details/80575615
'自定义函数用于工作表时，必须是被动式的，只是返回一个值，不能处理单元格或在工作表上修改，批注是个例外，不能调用range的方法，如：Find，Range.Replace例外
Function ReSplit(rng As Range)
    Dim newStr As String
    Dim countNum As Integer
    
    old = Strings.Split(rng, " ")
    For Each e In old
        If e <> "" Then
            'MsgBox TypeName(e)
            'Replace(, "/", "")
            With CreateObject("VBSCRIPT.REGEXP")
                .Global = True
                .IgnoreCase = True
                .Pattern = "([a-zA-Z]+)([0-9]+)-([0-9]+)"
                If .test(e) Then
                    '执行正则表达式，获取子匹配列表
                    Set da = .Execute(e)(0).SubMatches
                    last = da(0)
                    st = da(1)
                    en = da(2)
                    'Debug.Print last, st, en
                    For i = st To en
                        newStr = newStr & "," & last & i
                        countNum = countNum + 1
                    Next
                Else
                    newStr = newStr & "," & e
                    countNum = countNum + 1
                End If
            End With
        End If
    Next
    If InStr(newStr, ",") Then
        newStr = Right(newStr, Len(newStr) - 1)
    End If
    Debug.Print newStr
    Debug.Print countNum
    
    ReSplit = newStr
    
    'ActiveCell.Address '这是当前单元格地址
    'Selection.Offset(1, 0).Select '这是向下跳1格
    'Selection.Offset(-1, 0).Select '这是向上跳1格
    'Selection.Offset(0, -1).Select '这是向左跳1格
    'Selection.Offset(0, 1).Select '这是向右跳1格

End Function


Function SplitCount(rng As Range, delimiter As String)
   SplitCount = Len(Strings.Split(rng, delimiter))
End Function

Sub SetValue(offset As Range, value)
    offset = value
End Sub


Sub run()
    Set rng = Application.InputBox(prompt:="请选择区域", Type:=8)
    If rng.Count = 0 Then
        MsgBox "请至少选择一个单元格！", , "提示":
        Exit Sub
    End If
    'If rng.Count <> 1 Then
        'MsgBox "只能选择一个单元格！", , "提示":
        'Exit Sub
    'End If
    Debug.Print "当前选择：", rng.Address(1, 1)
    
    rngs = Strings.Split(rng.Address(1, 1), ":")
    st = Strings.Split(rngs(0), "$")(1)
    sta = Replace(rngs(0), "$", "")
    'Debug.Print rngs(0), st, sta
    
    of1Content = "整理后的数据"
    of2Content = "整理后的统计"
    If Range(st & "1").offset(0, 1) <> of1Content Then
        '插入空列
        Range(sta).offset(0, 1).EntireColumn.Insert
        Range(st & "1").offset(0, 1) = of1Content
    End If
    If Range(st & "1").offset(0, 2) <> of2Content Then
        Range(sta).offset(0, 2).EntireColumn.Insert
        Range(st & "1").offset(0, 2) = of2Content
    End If
    
    For Each im In rng
        
        If im <> "" Then
            'Debug.Print TypeName(im), im.Address
            
            str1 = ReSplit(Range(Replace(im.Address, "$", "")))
            im.offset(0, 1) = str1
            im.offset(0, 2) = Application.CountA(Strings.Split(str1, ","))
        End If
    Next
End Sub

# 自动高亮行列十字突显

  1. 按 Alt + F11 打开 VBA 编辑器。
  2. 在左侧项目树中双击当前工作表（如 Sheet1）。 3.粘贴以下代码：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Cells.Interior.ColorIndex = xlNone ' 清除所有高亮
    If Target.Cells.Count > 1 Then Exit Sub ' 防止多选
    With Target.EntireRow
        .Interior.Color = RGB(255, 255, 0) ' 设置行高亮颜色（黄色）
    End With
    With Target.EntireColumn
        .Interior.Color = RGB(255, 255, 0) ' 设置列高亮颜色（黄色）
    End With
End Sub
  1. 保存并关闭 VBA 编辑器。
  2. 返回 Excel，点击任意单元格即可看到行和列被高亮显示。

← WindowsVBScript →