提取数字

zw0713

麻烦用VB代码，谢谢！！！！
1：D列带有“g,kg,ml”的数字提取到F列'G列

2：D列带有“KG”换算为“g”

shiruiqiang

zw0713

shiruiqiang 发表于 2024-3-7 11:40
还有点小问题

疏忽了，应该是1100

shiruiqiang

Sub test()
Dim rng As Range, ss, sj
Range("f2:g10").ClearContents
Set reg = CreateObject("vbscript.regexp")
For Each rng In Range("d2:d10")
n = 1
With reg
.Global = True
.Pattern = "(\d+\.?\d*)([a-zA-Z]+)"
   Set ss = .Execute(rng)
   For Each sj In ss
   n = n + 1
    If sj.SubMatches(1) = "kg" Then
    rng.Offset(0, n) = sj.SubMatches(0) * 1000
    Else
    rng.Offset(0, n) = sj.SubMatches(0)
    End If
   Next
   n = 0
End With
Next
End Sub

shiruiqiang

相加就这样

HLAI

换个不用正则的方法（其实是我不会），另外增加了单位
Private Sub CommandButton1_Click()
Dim iArr_Data()
With Sheet2
    .Range("E2:XFD1048576").ClearContents
    iRow_Data = .Range("D1048576").End(xlUp).Row
    iArr_Data() = .Range("D2:D" & iRow_Data)
    niArr_Data = iRow_Data - 1
    For i = 1 To niArr_Data
        y = 0
        myQty = Empty
        myName = iArr_Data(i, 1)
        k = Len(myName)
        For j = 1 To k
            myWord = Mid(myName, j, 1)
            If IsNumeric(myWord) = True Or myWord = "." Then
                If LCase(Mid(myName, j + 1, 2)) = "kg" Or LCase(Mid(myName, j + 1, 2)) = "ml" Or LCase(Mid(myName, j + 1, 1)) = "g" Then
                    myQty = myQty & myWord
                    If LCase(Mid(myName, j + 1, 2)) = "kg" Then
                        .Cells(i + 1, 5 + y * 2).Value2 = myQty * 1000
                        .Cells(i + 1, 6 + y * 2).Value2 = "g"
                    End If
                    If LCase(Mid(myName, j + 1, 2)) = "ml" Then
                        .Cells(i + 1, 5 + y * 2).Value2 = myQty * 1
                        .Cells(i + 1, 6 + y * 2).Value2 = "ml"
                    End If
                    If LCase(Mid(myName, j + 1, 1)) = "g" Then
                        .Cells(i + 1, 5 + y * 2).Value2 = myQty * 1
                        .Cells(i + 1, 6 + y * 2).Value2 = "g"
                    End If
                    y = y + 1
                    myQty = Empty
                Else
                    myQty = myQty & myWord
                    If IsNumeric(myQty) = False Then myQty = Empty
                End If
            Else
                myQty = Empty
            End If
        Next
    Next
End With
Erase iArr_Data()
End Sub