正则表达式

颂风侯

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim changedRow As Long
  Dim text As String

  ' 监控范围：B, C, D, E 列
  If Not Intersect(Target, Me.Range("B:E")) Is Nothing Then
  changedRow = Target.row

  ' 如果行数大于3
  If changedRow > 3 Then
    ' 清空该行的H, I, J, K单元格的数据
    Me.Range("H" & changedRow & ":K" & changedRow).ClearContents

    ' 合并B, C, D, E列内容为一个字符串
    text = Join(Application.Transpose(Application.Transpose(Me.Range("B" & changedRow & ":E" & changedRow).Value)), "")

    ' 第一个判断：无缝钢管且不含锌
    If CheckBasicCondition(text, False) Then
      Me.Cells(changedRow, "H").Value = "无缝钢管"
      ' 后续条件分析并赋值I, J列
      'I标准
      AssignStandards_I text, changedRow
      'K材质
      AssignMaterials_K text, changedRow
      'J规格
      AssignDimensions_J text, row
    End If

    ' 第二个判断：无缝钢管且含锌
    If CheckBasicCondition(text, True) Then
      Me.Cells(changedRow, "H").Value = "无缝钢管(镀锌)"
    End If
  End If
  End If
End Sub

Function CheckBasicCondition(ByVal text As String, ByVal containsZinc As Boolean) As Boolean
  If InStr(text, "无缝") > 0 And InStr(text, "钢管") > 0 Then
  If containsZinc Then
    CheckBasicCondition = (InStr(text, "锌") > 0 Or InStr(text, "zinc") > 0 Or InStr(text, "galv") > 0)
  Else
    CheckBasicCondition = (InStr(text, "锌") = 0 And InStr(text, "zinc") = 0 And InStr(text, "galv") = 0)
  End If
  Else
  CheckBasicCondition = False
  End If
End Function

Sub AssignStandards_I(ByVal text As String, ByVal row As Long)
  Select Case True
  Case InStr(text, "3405") > 0
    Cells(row, "I").Value = "SH/T3405"
  Case InStr(text, "36.10") > 0
    Cells(row, "I").Value = "ASME B36.10"
  Case InStr(text, "36.19") > 0
    Cells(row, "I").Value = "ASME B36.19"
  Case InStr(text, "20553") > 0
    If InStr(text, "a") > 0 Then
      Cells(row, "I").Value = "HG/T20553(Ⅰa)"
    ElseIf InStr(text, "b") > 0 Then
      Cells(row, "I").Value = "HG/T20553(Ⅰb)"
    ElseIf InStr(text, "Ⅱ") > 0 Then
      Cells(row, "I").Value = "HG/T20553(Ⅱ)"
    End If
  Case InStr(text, "17395") > 0
    If InStr(text, "Ⅰ") > 0 Then
      Cells(row, "I").Value = "GB/T17395(Ⅰ)"
    ElseIf InStr(text, "Ⅱ") > 0 Then
      Cells(row, "I").Value = "GB/T17395(Ⅱ)"
    ElseIf InStr(text, "Ⅲ") > 0 Then
      Cells(row, "I").Value = "GB/T17395(Ⅲ)"
    End If
  End Select
End Sub

Sub AssignMaterials_K(ByVal text As String, ByVal row As Long)
  Select Case True
  Case InStr(text, "20") > 0 And InStr(text, "8163") > 0
    Cells(row, "K").Value = "20-GB/T8163"
  Case InStr(text, "20") > 0 And InStr(text, "9948") > 0
    Cells(row, "K").Value = "20-GB/T9948"
  Case InStr(text, "20") > 0 And InStr(text, "3087") > 0
    Cells(row, "K").Value = "20-GB/T3087"
  Case InStr(text, "20") > 0 And InStr(text, "5310") > 0
    Cells(row, "K").Value = "20G-GB/T5310"
  Case InStr(text, "15Cr") > 0 And InStr(text, "9948") = 0
    Cells(row, "K").Value = "15CrMoG-GB/T5310"
  Case InStr(text, "12Cr") > 0
    Cells(row, "K").Value = "12Cr1MoVG-GB/T5310"
  Case InStr(text, "15CrMo") > 0 And InStr(text, "9948") > 0
    Cells(row, "K").Value = "15CrMo-GB/T9948"
  Case InStr(text, "30403") > 0
    Cells(row, "K").Value = "S30403-GB/T14976"
  Case InStr(text, "316") > 0
    Cells(row, "K").Value = "S31603-GB/T14976"
  Case InStr(text, "310") > 0
    Cells(row, "K").Value = "S31008-GB/T14976"
  Case InStr(text, "2205") > 0
    Cells(row, "K").Value = "S22053-GB/T14976"
  Case InStr(text, "304") > 0 And InStr(text, "13296") > 0
    Cells(row, "K").Value = "S30408-GB/T13296"
  Case InStr(text, "304") > 0 And InStr(text, "312") > 0
    Cells(row, "K").Value = "TP304-A312"
  Case InStr(text, "304") > 0 And InStr(text, "30403") = 0
    Cells(row, "K").Value = "S30408-GB/T14976"
  End Select
End Sub


Sub AssignDimensions_J(ByVal text As String, ByVal row As Long)
    Dim regex As Object
    Dim matches As Object
    Dim matchPattern As String

   
    matchPattern = "(\d+)[x*](\d+(\.\d+)?)"

    ' 创建正则表达式对象
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .pattern = matchPattern
        .Global = False
    End With

    ' 执行正则表达式匹配
    If regex.Test(text) Then
        Set matches = regex.Execute(text)
        ' 如果有匹配项，生成指定格式的字符串
        If matches.Count > 0 Then
            Cells(row, "J").Value = "Φ" & matches(0).SubMatches(0) & "*" & matches(0).SubMatches(1)
        End If
    End If
End Sub

这个出错，帮看看问题，主要正则表达式出错

FishC

看起来您在 `AssignDimensions_J` 子程序中的正则表达式配置存在一些问题。您准备使用正则表达式来提取两个数字，但正则表达式 `(\d+)(\d+(\.\d+)?)` 中有些不对劲，尤其在小数解析方面。下面是改进的正则表达式：

1. `(\d+)`: 用于匹配整数部分。
2. `(\.\d+)?`: 用于匹配可选的小数部分。
3. `(\d+(\.\d+)?)`: 用于匹配第二个数字，支持小数。

这里是修改后的代码：

Sub AssignDimensions_J(ByVal text As String, ByVal row As Long)
    Dim regex As Object
    Dim matches As Object
    Dim matchPattern As String

    matchPattern = "(\d+(\.\d+)?)\s*[xX×*]\s*(\d+(\.\d+)?)"
    
    ' 创建正则表达式对象
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .pattern = matchPattern
        .Global = False
        .IgnoreCase = True
    End With
    
    ' 执行正则表达式匹配
    If regex.Test(text) Then
        Set matches = regex.Execute(text)
        ' 如果有匹配项，生成指定格式的字符串
        If matches.Count > 0 Then
            Cells(row, "J").Value = "Φ" & matches(0).SubMatches(0) & "*" & matches(0).SubMatches(2)
        End If
    End If
End Sub

改进后的正则表达式 `(\d+(\.\d+)?)\s*[xX×*]\s*(\d+(\.\d+)?)` 用于匹配形如 “数字x数字” 的格式，并且支持小数点。此外，增加了对乘号的不同表示法的容错支持，包括小写字母 x、乘号、“×” 和星号 “*”。

请确保在提取数字的同时留意小数和整数的处理，以准确存储规格信息。

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。