用VBA把姓名分拆成两列

laoau138

用VBA把姓名分拆成两列

pengyx

1、看豆号，把名字和性别取出
2、看括号，取出性别
3、把女的写入数组并编号
4、把数组写入单元格
代码不超过10行。但这里可能没人写

wp8680

1. Private Sub CommandButton1_Click()
   
2.     Dim arr, n%
   
3.     arr = Split(Range("a1").Value, ",")
   
4.     For n = 0 To UBound(arr)
   
5.         If InStr(arr(n), "女") Then
   
6.             With Range("b" & Cells.Rows.Count).End(xlUp)
   
7.                 .Offset(1, 0).Value = .Row - 4
   
8.                 .Offset(1, 1).Value = Split(arr(n), "(")(0)
   
9.             End With
   
10.         End If
    
11.     Next n
    
12. End Sub

复制代码

laoau138

pengyx 发表于 2016-9-20 19:24
1、看豆号，把名字和性别取出
2、看括号，取出性别
3、把女的写入数组并编号

既然没人写，为何还打五行字你是故意的

laoau138

wp8680 发表于 2016-9-20 19:26

不要用instr

laoau138

Sub 提取姓名()
Dim i%,str$, mat, reg
Set reg = CreateObject("vbscript.regexp")
str = Range("A1").Value
With reg
    .Global = True
    .Pattern = "([\u4e00-\u9fa5]+)\("
    Set mat = .Execute(str)
End With
For i = 0 To mat.Count - 1
    Cells(i + 6, 2) = i + 1
    Cells(i + 6, 3).Value = mat(i).SubMatches(0)
Next
End Sub

laoau138

Sub 提取()
Dim i%, k%, arr, brr
arr = Split(Range("A1").Value, ",")
ReDim brr(1 To UBound(arr), 1 To 2)
For i = 0 To UBound(arr)
    If InStr(arr(i), "女") Then
        k = k + 1
        brr(k, 1) = k
        brr(k, 2) = Replace(arr(i), "(女)", "")
    End If
Next
Range("B6").Resize(k, 2) = brr
End Sub

laoau138

wp8680 发表于 2016-9-20 19:26

VBA蓝底单元格输入数字全排列   然后再容错

http://www.excelpx.com/thread-427027-1-1.html