[已解决]求助一个vba

颂风侯

考虑写一个excel工作表change的事件
如果行数大于3，当列数为B,C,D,E的单元格内容发生改变时候，
首先清空该行的H,I,J,K的单元格的数据
将变更单元格行的B,C,D,E的单元格的内容合并为一个字符串
对这个字符串进行分析，
分支选择如下
1.如果字符串包含以下字段组合，"无缝","钢管",且不含"锌"或者"zinc"或者"galv",将该单元格所在行的H列单元格赋值为"无缝钢管"，此处是后续判断的基础，作为程序设计标记为"判断1.1"
在"判断1.1"的基础上增加判断，
  如果字符串包含"3405",将该单元格所在行的I列单元格赋值为"SH/T3405"；
  如果字符串包含"36.10",将该单元格所在行的I列单元格赋值为"ASME B36.10"；
  如果字符串包含"36.19",将该单元格所在行的I列单元格赋值为"ASME B36.19"；
  如果字符串包含"20553"且含有"a",将该单元格所在行的I列单元格赋值为"HG/T20553(Ⅰa)"；
  如果字符串包含"20553"且含有"b",将该单元格所在行的I列单元格赋值为"HG/T20553(Ⅰb)"；
  如果字符串包含"20553"且含有"Ⅱ",将该单元格所在行的I列单元格赋值为"HG/T20553(Ⅱ)"；
  如果字符串包含"17395"且含有"Ⅰ",将该单元格所在行的I列单元格赋值为"GB/T17395(Ⅰ)"；
  如果字符串包含"17395"且含有"Ⅱ",将该单元格所在行的I列单元格赋值为"GB/T17395(Ⅱ)"；
  如果字符串包含"17395"且含有"Ⅲ",将该单元格所在行的I列单元格赋值为"GB/T17395(Ⅲ)"；
在"判断1.1"的基础上增加判断，
  如果字符串包含"20"且含有"8163",将该单元格所在行的J列单元格赋值为"20-GB/T8163"；
  如果字符串包含"20"且含有"9948",将该单元格所在行的J列单元格赋值为"20-GB/T9948"；
  如果字符串包含"20"且含有"3087",将该单元格所在行的J列单元格赋值为"20-GB/T3087"；
  如果字符串包含"20"且含有"5310",将该单元格所在行的J列单元格赋值为"20G-GB/T5310"；
  如果字符串包含"15Cr"且不含有"9948",将该单元格所在行的J列单元格赋值为"15CrMoG-GB/T5310"；
  如果字符串包含"12Cr",将该单元格所在行的J列单元格赋值为"12Cr1MoVG-GB/T5310"；
  如果字符串包含"15CrMo"且含有"9948",将该单元格所在行的J列单元格赋值为"15CrMo-GB/T9948"；S30403-GB/T14976
  如果字符串包含"30403",将该单元格所在行的J列单元格赋值为"S30403-GB/T14976"；
  如果字符串包含"316",将该单元格所在行的J列单元格赋值为"S31603-GB/T14976"；
  如果字符串包含"310",将该单元格所在行的J列单元格赋值为"S31008-GB/T14976"；
  如果字符串包含"2205",将该单元格所在行的J列单元格赋值为"S22053-GB/T14976"
  如果字符串包含"304"且含有"13296",将该单元格所在行的J列单元格赋值为"S30408-GB/T13296"
  如果字符串包含"304"且含有"312",将该单元格所在行的J列单元格赋值为"TP304-A312"
  如果字符串包含"304且不含有包含"30403",将该单元格所在行的J列单元格赋值为"S30408-GB/T14976"；

如果字符串包含以下字段组合，"无缝","钢管",且含"锌"或者"zinc"或者"galv",将该单元格所在行的H列单元格赋值为"无缝钢管(镀锌)"

要求该代码以VBA写，且重复得用sub，function进行封装简化，保证后续程序重复调用，并且充分得写注释

最佳答案

月排行榜 / 总排行榜

FishC

2024-12-27 16:02:58

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

以上的VBA代码通过Worksheet_Change事件实现了所需的功能。代码将事件处理程序封装在各自的Sub和Function中，便于重复调用和简化代码结构。注释和函数命名提供了逻辑的清晰划分，可以帮助理解和维护代码。

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

跳转到最佳答案楼层

FishC

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

以上的VBA代码通过Worksheet_Change事件实现了所需的功能。代码将事件处理程序封装在各自的Sub和Function中，便于重复调用和简化代码结构。注释和函数命名提供了逻辑的清晰划分，可以帮助理解和维护代码。

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

颂风侯

考虑写一个excel工作表change的事件
如果行数大于3，当列数为B,C,D,E的单元格内容发生改变时候，
首先清空该行的H,I,J,K的单元格的数据
将变更单元格行的B,C,D,E的单元格的内容合并为一个字符串
对这个字符串进行分析，
分支选择如下
1.如果字符串包含以下字段组合，"无缝","钢管",且不含"锌"或者"zinc"或者"galv",将该单元格所在行的H列单元格赋值为"无缝钢管"，此处是后续判断的基础，作为程序设计标记为"判断1.1"
在"判断1.1"的基础上增加判断，
  如果字符串包含"3405",将该单元格所在行的I列单元格赋值为"SH/T3405"；
  如果字符串包含"36.10",将该单元格所在行的I列单元格赋值为"ASME B36.10"；
  如果字符串包含"36.19",将该单元格所在行的I列单元格赋值为"ASME B36.19"；
  如果字符串包含"20553"且含有"a",将该单元格所在行的I列单元格赋值为"HG/T20553(Ⅰa)"；
  如果字符串包含"20553"且含有"b",将该单元格所在行的I列单元格赋值为"HG/T20553(Ⅰb)"；
  如果字符串包含"20553"且含有"Ⅱ",将该单元格所在行的I列单元格赋值为"HG/T20553(Ⅱ)"；
  如果字符串包含"17395"且含有"Ⅰ",将该单元格所在行的I列单元格赋值为"GB/T17395(Ⅰ)"；
  如果字符串包含"17395"且含有"Ⅱ",将该单元格所在行的I列单元格赋值为"GB/T17395(Ⅱ)"；
  如果字符串包含"17395"且含有"Ⅲ",将该单元格所在行的I列单元格赋值为"GB/T17395(Ⅲ)"；
在"判断1.1"的基础上增加判断，
  如果字符串包含"20"且含有"8163",将该单元格所在行的J列单元格赋值为"20-GB/T8163"；
  如果字符串包含"20"且含有"9948",将该单元格所在行的J列单元格赋值为"20-GB/T9948"；
  如果字符串包含"20"且含有"3087",将该单元格所在行的J列单元格赋值为"20-GB/T3087"；
  如果字符串包含"20"且含有"5310",将该单元格所在行的J列单元格赋值为"20G-GB/T5310"；
  如果字符串包含"15Cr"且不含有"9948",将该单元格所在行的J列单元格赋值为"15CrMoG-GB/T5310"；
  如果字符串包含"12Cr",将该单元格所在行的J列单元格赋值为"12Cr1MoVG-GB/T5310"；
  如果字符串包含"15CrMo"且含有"9948",将该单元格所在行的J列单元格赋值为"15CrMo-GB/T9948"；S30403-GB/T14976
  如果字符串包含"30403",将该单元格所在行的J列单元格赋值为"S30403-GB/T14976"；
  如果字符串包含"316",将该单元格所在行的J列单元格赋值为"S31603-GB/T14976"；
  如果字符串包含"310",将该单元格所在行的J列单元格赋值为"S31008-GB/T14976"；
  如果字符串包含"2205",将该单元格所在行的J列单元格赋值为"S22053-GB/T14976"
  如果字符串包含"304"且含有"13296",将该单元格所在行的J列单元格赋值为"S30408-GB/T13296"
  如果字符串包含"304"且含有"312",将该单元格所在行的J列单元格赋值为"TP304-A312"
  如果字符串包含"304且不含有包含"30403",将该单元格所在行的J列单元格赋值为"S30408-GB/T14976"；

在"判断1.1"的基础上增加判断，
如果字符串包含类似于"Φ133x4","Φ133x4.5","Φ45*4.5"这些类型的数据，将该单元格所在行的K列单元格赋值为"Φ？？*？？"数据；



如果字符串包含以下字段组合，"无缝","钢管",且含"锌"或者"zinc"或者"galv",将该单元格所在行的H列单元格赋值为"无缝钢管(镀锌)"

要求该代码以VBA写，且重复得用sub，function进行封装简化，保证后续程序重复调用，并且充分得写注释

FishC

颂风侯 发表于 2024-12-27 16:20
考虑写一个excel工作表change的事件
如果行数大于3， ...

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)), "")
            
            ' 第一分支选择逻辑
            Call BasicConditionCheck(text, changedRow)
        End If
    End If
End Sub

Sub BasicConditionCheck(ByVal text As String, ByVal row As Long)
    ' 判断字符串中是否包含 "无缝", "钢管" 且不包含 "锌", "zinc", "galv"
    If InStr(text, "无缝") > 0 And InStr(text, "钢管") > 0 Then
        If InStr(text, "锌") = 0 And InStr(text, "zinc") = 0 And InStr(text, "galv") = 0 Then
            Cells(row, "H").Value = "无缝钢管"
            
            ' 后续判定并赋值I, J, K列
            AssignStandards_I text, row
            AssignMaterials_J text, row
            AssignDimensions_K text, row
        ElseIf InStr(text, "锌") > 0 Or InStr(text, "zinc") > 0 Or InStr(text, "galv") > 0 Then
            Cells(row, "H").Value = "无缝钢管(镀锌)"
        End If
    End If
End Sub

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

Sub AssignDimensions_K(ByVal text As String, ByVal row As Long)
    Dim pattern As String
    Dim match As Object
    Dim regex As Object

    ' 正则表达式查找形如 "Φ133x4", "Φ133x4.5", "Φ45*4.5"
    pattern = "Φ\d+[\*x]\d+\.?\d*"
    
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Pattern = pattern
        .Global = False
        .IgnoreCase = True
    End With

    If regex.Test(text) Then
        Set match = regex.Execute(text)(0)
        Cells(row, "K").Value = match.Value
    End If
End Sub

此代码通过事件处理和分支判断实现了所需功能。其中：

- `Worksheet_Change` 事件函数用于监控特定列的变化，触发相应的操作。
- `BasicConditionCheck` 用于基础条件判断，并调用其他子程序对特定列进行操作。
- `AssignStandards_I` 和 `AssignMaterials_J` 用于在满足条件时填充I和J列。
- `AssignDimensions_K` 使用正则表达式查找特定格式的数据并赋值K列。

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

颂风侯

考虑写一个excel工作表change的事件
如果行数大于3，当列数为B,C,D,E的单元格内容发生改变时候，
首先清空该行的H,I,J,K的单元格的数据
将变更单元格行的B,C,D,E的单元格的内容合并为一个字符串
对这个字符串进行分析，
分支选择如下
1.如果字符串包含以下字段组合，"无缝","钢管",且不含"锌"或者"zinc"或者"galv",将该单元格所在行的H列单元格赋值为"无缝钢管"，此处是后续判断的基础，作为程序设计标记为"判断1.1"
在"判断1.1"的基础上增加判断，
  如果字符串包含"3405",将该单元格所在行的I列单元格赋值为"SH/T3405"；
  如果字符串包含"36.10",将该单元格所在行的I列单元格赋值为"ASME B36.10"；
  如果字符串包含"36.19",将该单元格所在行的I列单元格赋值为"ASME B36.19"；
  如果字符串包含"20553"且含有"a",将该单元格所在行的I列单元格赋值为"HG/T20553(Ⅰa)"；
  如果字符串包含"20553"且含有"b",将该单元格所在行的I列单元格赋值为"HG/T20553(Ⅰb)"；
  如果字符串包含"20553"且含有"Ⅱ",将该单元格所在行的I列单元格赋值为"HG/T20553(Ⅱ)"；
  如果字符串包含"17395"且含有"Ⅰ",将该单元格所在行的I列单元格赋值为"GB/T17395(Ⅰ)"；
  如果字符串包含"17395"且含有"Ⅱ",将该单元格所在行的I列单元格赋值为"GB/T17395(Ⅱ)"；
  如果字符串包含"17395"且含有"Ⅲ",将该单元格所在行的I列单元格赋值为"GB/T17395(Ⅲ)"；
在"判断1.1"的基础上增加判断，
  如果字符串包含"20"且含有"8163",将该单元格所在行的J列单元格赋值为"20-GB/T8163"；
  如果字符串包含"20"且含有"9948",将该单元格所在行的J列单元格赋值为"20-GB/T9948"；
  如果字符串包含"20"且含有"3087",将该单元格所在行的J列单元格赋值为"20-GB/T3087"；
  如果字符串包含"20"且含有"5310",将该单元格所在行的J列单元格赋值为"20G-GB/T5310"；
  如果字符串包含"15Cr"且不含有"9948",将该单元格所在行的J列单元格赋值为"15CrMoG-GB/T5310"；
  如果字符串包含"12Cr",将该单元格所在行的J列单元格赋值为"12Cr1MoVG-GB/T5310"；
  如果字符串包含"15CrMo"且含有"9948",将该单元格所在行的J列单元格赋值为"15CrMo-GB/T9948"；S30403-GB/T14976
  如果字符串包含"30403",将该单元格所在行的J列单元格赋值为"S30403-GB/T14976"；
  如果字符串包含"316",将该单元格所在行的J列单元格赋值为"S31603-GB/T14976"；
  如果字符串包含"310",将该单元格所在行的J列单元格赋值为"S31008-GB/T14976"；
  如果字符串包含"2205",将该单元格所在行的J列单元格赋值为"S22053-GB/T14976"
  如果字符串包含"304"且含有"13296",将该单元格所在行的J列单元格赋值为"S30408-GB/T13296"
  如果字符串包含"304"且含有"312",将该单元格所在行的J列单元格赋值为"TP304-A312"
  如果字符串包含"304且不含有包含"30403",将该单元格所在行的J列单元格赋值为"S30408-GB/T14976"；

在"判断1.1"的基础上增加判断，
如果字符串包含类似于"Φ133x4","Φ133x4.5","Φ45*4.5","φ45*4.5"这些类型的数据，将该单元格所在行的K列单元格赋值为"Φ？？*？？"数据；



如果字符串包含以下字段组合，"无缝","钢管",且含"锌"或者"zinc"或者"galv",将该单元格所在行的H列单元格赋值为"无缝钢管(镀锌)"

要求该代码以VBA写，且重复得用sub，function进行封装简化，保证后续程序重复调用，并且充分得写注释

FishC

颂风侯 发表于 2024-12-27 16:35
考虑写一个excel工作表change的事件
如果行数大于3， ...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim changedRow As Long
    Dim concatenatedText 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列内容为单个字符串
            concatenatedText = Join(Application.Transpose(Application.Transpose(Me.Range("B" & changedRow & ":E" & changedRow).Value)), "")
            
            ' 条件判断和赋值
            If CheckSeamlessPipe(concatenatedText) Then
                Me.Cells(changedRow, "H").Value = "无缝钢管"
                AssignStandards_I concatenatedText, changedRow
                AssignMaterials_J concatenatedText, changedRow
                AssignDimensions_K concatenatedText, changedRow
            ElseIf CheckGalvanizedPipe(concatenatedText) Then
                Me.Cells(changedRow, "H").Value = "无缝钢管(镀锌)"
            End If
        End If
    End If
End Sub

Function CheckSeamlessPipe(ByVal text As String) As Boolean
    ' 检查是否为无缝钢管且不含锌
    CheckSeamlessPipe = InStr(text, "无缝") > 0 And InStr(text, "钢管") > 0 And _
                        InStr(text, "锌") = 0 And InStr(text, "zinc") = 0 And InStr(text, "galv") = 0
End Function

Function CheckGalvanizedPipe(ByVal text As String) As Boolean
    ' 检查是否为镀锌无缝钢管
    CheckGalvanizedPipe = InStr(text, "无缝") > 0 And InStr(text, "钢管") > 0 And _
                          (InStr(text, "锌") > 0 Or InStr(text, "zinc") > 0 Or InStr(text, "galv") > 0)
End Function

Sub AssignStandards_I(ByVal text As String, ByVal row As Long)
    ' 设置I列标准
    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_J(ByVal text As String, ByVal row As Long)
    ' 设置J列材料
    Select Case True
        Case InStr(text, "20") > 0 And InStr(text, "8163") > 0
            Cells(row, "J").Value = "20-GB/T8163"
        Case InStr(text, "20") > 0 And InStr(text, "9948") > 0
            Cells(row, "J").Value = "20-GB/T9948"
        Case InStr(text, "20") > 0 And InStr(text, "3087") > 0
            Cells(row, "J").Value = "20-GB/T3087"
        Case InStr(text, "20") > 0 And InStr(text, "5310") > 0
            Cells(row, "J").Value = "20G-GB/T5310"
        Case InStr(text, "15Cr") > 0 And InStr(text, "9948") = 0
            Cells(row, "J").Value = "15CrMoG-GB/T5310"
        Case InStr(text, "12Cr") > 0
            Cells(row, "J").Value = "12Cr1MoVG-GB/T5310"
        Case InStr(text, "15CrMo") > 0 And InStr(text, "9948") > 0
            Cells(row, "J").Value = "15CrMo-GB/T9948"
        Case InStr(text, "30403") > 0
            Cells(row, "J").Value = "S30403-GB/T14976"
        Case InStr(text, "316") > 0
            Cells(row, "J").Value = "S31603-GB/T14976"
        Case InStr(text, "310") > 0
            Cells(row, "J").Value = "S31008-GB/T14976"
        Case InStr(text, "2205") > 0
            Cells(row, "J").Value = "S22053-GB/T14976"
        Case InStr(text, "304") > 0 And InStr(text, "13296") > 0
            Cells(row, "J").Value = "S30408-GB/T13296"
        Case InStr(text, "304") > 0 And InStr(text, "312") > 0
            Cells(row, "J").Value = "TP304-A312"
        Case InStr(text, "304") > 0 And InStr(text, "30403") = 0
            Cells(row, "J").Value = "S30408-GB/T14976"
    End Select
End Sub

Sub AssignDimensions_K(ByVal text As String, ByVal row As Long)
    Dim pattern As String
    Dim regex As Object
    Dim matches As Object

    ' 使用正则表达式匹配类似"Φ133x4","Φ133x4.5","Φ45*4.5","φ45*4.5"的模式
    pattern = "Φ[\d.]+x[\d.]+|Φ[\d.]+\*[\d.]+|φ[\d.]+x[\d.]+|φ[\d.]+\*[\d.]+"
    Set regex = CreateObject("VBScript.RegExp")
    
    ' 配置正则对象
    With regex
        .Pattern = pattern
        .Global = False
        .IgnoreCase = True
    End With

    ' 如果符合匹配条件，则赋值K列
    If regex.Test(text) Then
        Set matches = regex.Execute(text)
        Cells(row, "K").Value = matches(0).Value
    End If
End Sub

以上代码实现了所需逻辑，包括：
1. 根据内容在H列进行基本判断。
2. 在满足基本判断的基础上将特定内容赋值到I列和J列。
3. 使用正则表达式将特定格式（如Φ133x4）的内容赋值到K列。
4. 各功能通过封装成独立的Sub或Function来实现，以便代码复用和维护。

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

颂风侯

Sub AssignDimensions_K(ByVal text As String, ByVal row As Long)
  Dim pattern As String
  Dim match As Object
  Dim regex As Object

  ' 正则表达式查找形如 "Φ133x4", "Φ133x4.5", "Φ45*4.5"
  pattern = "Φ[\d.]+x[\d.]+|Φ[\d.]+\*[\d.]+|φ[\d.]+x[\d.]+|φ[\d.]+\*[\d.]+"

  Set regex = CreateObject("VBScript.RegExp")
  With regex
  .pattern = pattern
  .Global = False
  .IgnoreCase = True
  End With

  If regex.Test(text) Then
  Set match = regex.Execute(text)(0)
  Cells(row, "K").Value = match.Value
  End If
End Sub

这里错误，提示运行时错误1004

FishC

颂风侯 发表于 2024-12-27 16:40
Sub AssignDimensions_K(ByVal text As String, ByVal ...

整理正则表达式用法有误。正则表达式的`Pattern`应该能够准确匹配字符串中的格式。在这一问题中，我们需要寻找的模式可以描述为“一个大写或小写的Φ（或φ）后面跟随一组数字，然后是x或*，再跟随一组数字”。正则表达式模式中也需要适当调整以确保大写和小写的匹配。

请尝试以下调整后的代码：

Sub AssignDimensions_K(ByVal text As String, ByVal row As Long)
    Dim pattern As String
    Dim matches As Object
    Dim regex As Object

    ' 正则表达式查找形如 "Φ133x4", "Φ133x4.5", "Φ45*4.5", "φ45*4.5"
    pattern = "Φ\d+x\d+(\.\d+)?|φ\d+\*\d+(\.\d+)?"

    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Pattern = pattern
        .Global = False
        .IgnoreCase = True
    End With

    If regex.Test(text) Then
        Set matches = regex.Execute(text)
        Cells(row, "K").Value = matches(0).Value
    End If
End Sub

注意：
1. 使用`\d+`以匹配一个或多个数字。
2. `(\.\d+)?`表示可选的小数部分匹配。
3. 确保对于大小写不同的Φ（phi）使用正确的字符"Φ"和"φ"。

以上修正应解决代码中的错误，并正确匹配所需的字符串格式。

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

颂风侯

Sub AssignDimensions_K(ByVal text As String, ByVal row As Long)
    Dim pattern As String
    Dim matches As Object
    Dim regex As Object

     ' 正则表达式查找形如 "Φ133x4", "Φ133x4.5", "Φ45*4.5", "φ45*4.5"
    pattern = "Φ\d+x\d+(\.\d+)?|φ\d+\*\d+(\.\d+)?"

    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .pattern = pattern
        .Global = False
        .IgnoreCase = True
    End With

    If regex.Test(text) Then
        Set matches = regex.Execute(text)
        Cells(row, "K").Value = matches(0).Value
    End If
End Sub
还是错误的。。。

FishC

颂风侯 发表于 2024-12-27 17:24
Sub AssignDimensions_K(ByVal text As String, ByVal ...

出现运行时错误的原因可能是正则表达式没有正确匹配您的数据格式。我们需要确保正则表达式能够匹配到正确格式的数据。在此例中，我们要搜索的数据类型为“Φ133x4”、“Φ133x4.5”、“φ45*4.5”等，正则表达式的模式应该准确捕获这些格式。

请尝试以下调整后的代码，它旨在捕获您指定的数据格式：

Sub AssignDimensions_K(ByVal text As String, ByVal row As Long)
    Dim pattern As String
    Dim matches As Object
    Dim regex As Object

    ' 正则表达式查找形如 "Φ133x4", "Φ133x4.5", "Φ45*4.5", "φ45*4.5"
    pattern = "[Φφ]\d+(\.\d+)?[x\*]\d+(\.\d+)?"

    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Pattern = pattern
        .Global = False
        .IgnoreCase = True
    End With

    If regex.Test(text) Then
        Set matches = regex.Execute(text)
        Cells(row, "K").Value = matches(0).Value
    End If
End Sub

### 说明：
1. `"[Φφ]\d+(\.\d+)?[x\*]\d+(\.\d+)?"` 用于匹配：
   - `[Φφ]`：匹配“Φ”或“φ”。
   - `\d+`：匹配一个或多个数字。
   - `(\.\d+)?`：匹配可选的小数部分。
   - `[x\*]`：匹配字母'x'或字符'*'。
   - 结尾的 `\d+(\.\d+)?` 与前面的格式对称，捕获最后的数字或小数。

2. 请确保输入数据格式正确，并确认是否含有指定字符。

这段代码在单元格内执行正则表达式并将匹配到的内容显示在 K 列。确保 `text` 包含目标字符串，以便正则表达式成功提取并显示结果。

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

颂风侯

在"判断1.1"的基础上增加判断，
如果字符串包含类似于"133x4","133x4.5","45*4.5"这些类型的数据，将该单元格所在行的K列单元格赋值为"Φ？？*？？"数据；

FishC

颂风侯 发表于 2024-12-27 17:33
在"判断1.1"的基础上增加判断，
如果字符串包含类似 ...

明白了，如果要匹配类似于“133x4”、“133x4.5”或“45*4.5”的数据，并将其格式化为“Φ??*??”并赋值到K列，可以使用以下代码：

Sub AssignDimensions_K(ByVal text As String, ByVal row As Long)
    Dim pattern As String
    Dim matches As Object
    Dim regex As Object
    Dim formattedValue As String

    ' 正则表达式查找形如 "133x4", "133x4.5", "45*4.5"
    pattern = "\d+(\.\d+)?[x*]\d+(\.\d+)?"

    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Pattern = pattern
        .Global = False
        .IgnoreCase = True
    End With

    If regex.Test(text) Then
        Set matches = regex.Execute(text)
        formattedValue = Replace(matches(0).Value, "x", "*")
        formattedValue = Replace(formattedValue, "X", "*")
        Cells(row, "K").Value = "Φ" & formattedValue
    End If
End Sub

### 说明：

1. **正则表达式模式** (`pattern`):
   - `\d+(\.\d+)?`: 匹配一个或多个数字，可以有可选的小数部分。
   - `[x*]`: 在"x"或"*"两个字符之间进行匹配。
   - 第二个`\d+(\.\d+)?`用于匹配"x"或"*"之后的数字或小数。

2. **代码逻辑**:
   - 使用正则表达式匹配 `text` 中是否含有指定的数字-分隔符-数字模式。
   - 使用 `Replace` 函数确保"x"和"X"都被替换为"*"，以标准化输出格式。
   - 将结果格式化为“Φ??*??”并赋值到相应行的K列。

确认输入数据格式遵循上述描述以确保成功匹配并处理。

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