求助正则表达式

戎马书生222

从K列扣分明细里，搜索到“周4”，就将后面的-1填充到周4列对应单元格，填充-1.其它类似，最后汇总出扣分。

希望大神给个思路，学习一下。

shiruiqiang

周\d[一-龢]+\-\d

数字转换中文，中文字典求列号

gwjkkkkk

shiruiqiang

偷懒了

gwjkkkkk

请参考附件。。。

ykcbf1100

更新一下。。。

ykcbf1100

1. Sub ykcbf()   '//2025.4.14
   
2.     On Error Resume Next
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a1].Resize(r, 11)
   
6.         For i = 2 To UBound(arr)
   
7.             If arr(i, 11) <> Empty Then
   
8.                 st = ston(arr(i, 11))
   
9.                 b = Split(st, ";")
   
10.                 For x = 0 To UBound(b)   '//多组数据循环提取
    
11.                     t = Split(b(x))
    
12.                     .Cells(i, Val(t(0))+1) = Val(t(1))
    
13.                 Next
    
14.                 .Cells(i, 9) = Application.Sum(.Cells(i, 2).Resize(, 7))
    
15.             End If
    
16.         Next
    
17.     End With
    
18. End Sub
    

复制代码

翁知江安

Sub test250413b()
Dim i, j, m, n, sum As Integer, ar, br As Variant, reg As Object, matches As Object, mat
Set reg = CreateObject("vbscript.regexp")
ar = Sheet1.[a1].CurrentRegion
Sheet1.[b2].Resize(UBound(ar), 8).ClearContents
ar = Sheet1.UsedRange
ReDim br(1 To UBound(ar), 1 To 14)
With reg
  .Global = 1
  .Pattern = "周\d|-\d"
  For i = 2 To UBound(ar)
  Set matches = .Execute(ar(i, 11))
  If matches.Count > 0 Then
  For Each mat In matches
  n = n + 1: br(i, n) = mat
  Next
  End If
  n = 0
  Next
End With
With Sheet1
For i = 2 To UBound(ar)
   For j = 1 To 13 Step 2
   If br(i, j) <> "" Then
   m = Val(Right(br(i, j), 1)): .Cells(i, 1).Offset(, m) = Val(br(i, j + 1))
   sum = sum + Val(br(i, j + 1))
   End If
   Next
   .Cells(i, 9) = sum: sum = 0
Next
End With
MsgBox "ok"
End Sub

翁知江安

供参考，欢迎批评指正

戎马书生222

看了各位的思路，明白了一部分了