excel VBA连接字符串n次

nzkunb0c  于 2023-08-08  发布在  其他
关注(0)|答案(5)|浏览(129)

我尝试连接字符串n次,我需要首先提取“(”和“)”之间的文本,然后连接它们,字符串通常看起来像这样
第一个月
这将是我正在寻找的解决方案


的数据
这是我尝试过的,它可以工作,但它只替换单元格i, lastcol + 1中的内容“newcount”次数,我知道我需要使用类似的东西
Oldvalue & " / " & Newvalue
但我不知道怎么把这个放进去

Dim StartPos, EndPos, newcount, i, a As Integer
Dim StrEx, Oldvalue, Newvalue As String

For i = rcount - Count To 4 Step -1
    StrEx = ActiveSheet.Cells(i, "G").Value
    newcount = Len(StrEx) - Len(Replace(StrEx, "(", ""))
        If Len(StrEx) - Len(Replace(StrEx, "(", "")) = 0 Then
        Else
            For a = 1 To newcount Step 1
                StrEx = ActiveSheet.Cells(i, "G").Value
                StartPos = InStr(StrEx, "(")
                EndPos = InStr(StrEx, ")")
                Oldvalue = Mid(StrEx, StartPos, EndPos - StartPos + 1)
                ActiveSheet.Cells(i, "G").Value = Application.WorksheetFunction.Substitute(StrEx, Oldvalue, "", 1)
                ActiveSheet.Cells(i, lastcol0 + 1).Value = Oldvalue
            Next a
        End If
Next i

个字符

jc3wubiy

jc3wubiy1#

另一种方式,因为你标记了Excel公式太:


的数据
B1中的公式:

=DROP(REDUCE(0,A1:A3,LAMBDA(x,y,VSTACK(x,LET(z,TEXTSPLIT(y,"/ "),HSTACK(TEXTJOIN(" / ",,LEFT(z,LEN(z)-11)),TEXTJOIN(" / ",,MID(z,LEN(z)-9,10))))))),1)

字符串

gojuced7

gojuced72#

使用正则表达式

Option Explicit

Sub macro1()

    Dim ws As Worksheet, ar
    Dim regex As Object, m As Object, s As String
    Dim i As Long, r As Long, lastrow As Long

    Set regex = CreateObject("vbscript.regexp")
    With regex
        .Global = True
        .MultiLine = False
        .IgnoreCase = True
        .Pattern = "(\(CI \d\d\d\d\d\))" ' pattern
    End With

    Set ws = Sheets(1)
    With ws
        lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row
        For r = 4 To lastrow
            s = .Cells(r, "G")
            If regex.test(s) Then
               Set m = regex.Execute(s)
               ReDim ar(1 To m.Count)
               For i = 1 To m.Count
                  ar(i) = m(i - 1)
               Next
            
               ' text
               .Cells(r, "H") = regex.Replace(s, "")
               
                ' CI ref
               .Cells(r, "I") = Join(ar, "/")
            End If
        Next
    End With
   
    MsgBox lastrow - 3 & " rows processed", vbInformation
   
End Sub

字符串

3gtaxfhh

3gtaxfhh3#

看看下面的套路。它处理一个单元格(这意味着您必须从数据循环中调用它),并将结果写入该单元格旁边的两个单元格中。
基本上,该例程使用VBA函数Split获取元素列表,然后循环遍历这些元素以将名称与CI编号分开。这两个片段都收集在数组中。循环结束后,使用Join将两个结果数组写入单元格。

Sub SplitMyString(cell As Range)
    Dim elements() As String, i As Long
    elements = Split(cell.Value, "/")
    ReDim elementNames(0 To UBound(elements))
    ReDim elementCI(0 To UBound(elements))
    
    For i = LBound(elements) To UBound(elements)
        Dim p As Long
        p = InStr(elements(i), "(")
        If p > 0 Then
            elementNames(i) = Trim(Left(elements(i), p - 1))
            elementCI(i) = Trim(Mid(elements(i), p))
        Else
            elementNames(i) = elements(i)
        End If
    Next i
    cell.Offset(0, 1) = Join(elementNames, " / ")
    cell.Offset(0, 2) = Join(elementCI, " / ")
End Sub

字符串

nr9pn0ug

nr9pn0ug4#

假设原始数据包含在列A中。处理后的结果将写入C列和D列。

Option Base 1
Sub demo()
    Dim lstRow, res()
    Dim aSplit, bSplit, b, i
    Dim sDeli As String
    Dim sTxt As String, sNum As String
    lstRow = [a1].End(xlDown).Row
    ReDim res(lstRow, 2)
    sDeli = " / "
    arr = [a1].Resize(lstRow, 1)
    For i = 1 To UBound(arr)
        sTxt = ""
        sNum = ""
        aSplit = Split(Trim(arr(i, 1)), "/")
        For Each b In aSplit
            bSplit = Split(b, " (")
            sTxt = sTxt & sDeli & Trim(bSplit(0))
            sNum = sNum & sDeli & "(" & bSplit(1)
        Next
        res(i, 1) = Mid(sTxt, 3)
        res(i, 2) = Mid(sNum, 3)
    Next
    Range("C:D").Clear
    [c1].Resize(lstRow, 2).Value = res()
End Sub

字符串
| B栏|C列|D列| Column D |
| --|--|--| ------------ |
| |氧化铁黑/氧化铁红/氧化铁黄|(CI 77499)/(CI 77491)/(CI 77492)| (CI 77499) / (CI 77491) / (CI 77492) |
| |氧化铁黑/氧化铁红|(CI 77499)/(CI 77491)| (CI 77499) / (CI 77491) |
| |氧化铁红|(CI 77491)| (CI 77491) |

uplii1fm

uplii1fm5#

通过一点重组,你可以Split字符串,然后提取旧的和新的:

Option Explicit

Sub Test()
    Dim rcount As Long
    Dim lastcol0 As Long
    With ActiveSheet
        rcount = .Cells(.Rows.count, "G").End(xlUp).Row
        lastcol0 = 8 ' ???
    
        Dim count As Long
        count = 0
    
        Dim i As Long
        For i = rcount - count To 4 Step -1
        
            Dim originalText As String
            originalText = .Cells(i, "G").Value
            
            Dim elements() As String
            elements = Split(originalText, "/")
            
            Dim j As Long
            For j = LBound(elements) To UBound(elements)
                Dim element As String
                element = elements(j)
                
                Dim oldValue As String
                Dim newValue As String
                oldValue = Trim$(Left$(element, InStr(1, element, "(") - 1))
                newValue = Trim$(Right$(element, _
                                 Len(element) - InStr(1, element, "(") + 1))
                .Cells(i + j, "G").Value = oldValue
                .Cells(i + j, "H").Value = newValue
            Next j
        Next i
    End With
End Sub

字符串

相关问题