Vba怎么根据单元格格式来复制上一行数据

[weixin_44039547]

比如#+* 例子：w+2 #：字母 *：数字 并将#和*的内容写入其他的单元格

[VB业余爱好者]

不知道充分理解你的意思了没有，左边是我做的例子，右边是结果，字体颜色为红色的都是发生变动的记录

Option Explicit

Private Sub TEST()
    Dim dataSource() As String  '存放原始数据
    Dim dataResult() As String  '存放结果数据
    Dim rowSource As Long       '原始记录行号
    Dim rowResult As Long       '结果记录行号
    Dim rowCopyL As Long        '要复制的行号（长整行）
    Dim rowCopyS As String        '要复制的行号（字符串）
    Dim posPlus As Integer      '加号的位置
    Dim i As Integer
    Dim j As Integer
    
    rowResult = 0
    
    rowSource = 2                     ' 从第2行开始，第1行为标题
    While Cells(rowSource, 2) <> ""   '先把原来的数据存起来
        ReDim Preserve dataSource(5, rowSource - 1)
        For i = 1 To 5
            dataSource(i, rowSource - 1) = Cells(rowSource, i)
        Next
        
        rowResult = rowResult + 1
        ReDim Preserve dataResult(5, rowResult)
        
        posPlus = InStr(1, dataSource(2, rowSource - 1), "+")   '取得“+”的位置
        
        If posPlus <> 0 Then    '本行第二列中含有“+”
            rowCopyS = Mid(dataSource(2, rowSource - 1), posPlus + 1) '取得“+”后面的数字
            If IsNumeric(rowCopyS) Then     '“+”后面有数字的情况，复制对应行
                rowCopyL = rowSource - 2 - CInt(rowCopyS)
            Else    '“+”后没有数字的情况，复制上一行
                rowCopyL = rowSource - 2
            End If
            
            For i = 1 To 5
                dataResult(i, rowResult) = dataSource(i, rowCopyL)
            Next
            dataResult(2, rowResult) = Mid(dataSource(2, rowSource - 1), 1, posPlus - 1)    '处理第2列数据为“+”前面的内容
            
            rowResult = rowResult + 1
            ReDim Preserve dataResult(5, rowResult)
            
            For i = 1 To 5
                dataResult(i, rowResult) = dataSource(i, rowSource - 1)
            Next
            dataResult(2, rowResult) = "+"    '处理第2列数据为“+”
        Else    '本行第二列中不含有“+”，原样输出
            For i = 1 To 5
                dataResult(i, rowResult) = dataSource(i, rowSource - 1)
            Next
        End If
    
        rowSource = rowSource + 1
    Wend
    
    
    For i = 2 To rowResult + 1
        For j = 1 To 5
            Cells(i, j + 6) = dataResult(j, i - 1)
        Next
    Next
End Sub

[weixin_44039547]

谢谢，我感觉你好牛x的样子
还有一点，就是单元格内只有一个+号的情况下也是原样输出怎么处理

[weixin_44039547]

这是我想要的效果

[weixin_44039547]

还有就是+号后面是字母也是原样输出

[VB业余爱好者]

把 if posPlus <> 0 then 改成下面试试
if posPlus <>0 and trim(dataSource(2, rowSource - 1)) <> "+" then

你先试试

[weixin_44039547]

不行，而且第一行是h的情况下没有输出

[weixin_44039547]

我想用正则表达式/w/+/d判断单元格是否满足条件，满足则复制对应行，不满足则原样输出，不知道能不能实现，刚接触vba，还没有足够的知识支撑

[VB业余爱好者]

麻烦再细化一下你的问题，没看懂你到底要干什么。

[weixin_44039547]

引用 1 楼 VB业余爱好者 的回复：

麻烦再细化一下你的问题，没看懂你到底要干什么。

假设有五列的数据，第二列中有诸如w+，h+1，q+3这种格式的数据，但不全是，如果第5行2列单元格的内容满足w+格式，在本行上面插入一行，并填入第4行1，3，4，5列的数据，第2列数据为+号前面的内容w，再把本行第2列单元格内容改成+号。+号后面有数字的话，如果h+1在第9行，那么插入那行的数据为第7行的，数字1表示中间跳一行复制数据，q+3则表示中间跳3行

[VB业余爱好者]

引用 2 楼 weixin_44039547 的回复:

引用 1 楼 VB业余爱好者 的回复：

麻烦再细化一下你的问题，没看懂你到底要干什么。

假设有五列的数据，第二列中有诸如w+，h+1，q+3这种格式的数据，但不全是，如果第5行2列单元格的内容满足w+格式，在本行上面插入一行，并填入第4行1，3，4，5列的数据，第2列数据为+号前面的内容w，再把本行第2列单元格内容改成+号。+号后面有数字的话，如果h+1在第9行，那么插入那行的数据为第7行的，数字1表示中间跳一行复制数据，q+3则表示中间跳3行

可以弄个带数据的表格解释一下吗？

[VB业余爱好者]

引用 10 楼 weixin_44039547 的回复:

我想用正则表达式/w/+/d判断单元格是否满足条件，满足则复制对应行，不满足则原样输出，不知道能不能实现，刚接触vba，还没有足够的知识支撑

嗨，你没看我的例子么？我的例子中列是有列标题的，所以正式数据是从第2才开始的。

正则表达式没怎么研究过，我无能无力。

[VB业余爱好者]

rowSource = 2 ' 从第2行开始，第1行为标题

我代码里面不是已经注释说明了么。。。

[VB业余爱好者]

你把rowSource改成1，就从第1行开始了

[weixin_44039547]

那个我解决了，但是输出的数据是从第二行开始，会空一行改哪个参数

[weixin_44039547]

还有只有+号原样输出怎么解决

[VB业余爱好者]

你这分太难挣了

Option Explicit
 
Private Sub TEST()
    Dim dataSource() As String  '存放原始数据
    Dim dataResult() As String  '存放结果数据
    Dim rowSource As Long       '原始记录行号
    Dim rowResult As Long       '结果记录行号
    Dim rowCopyL As Long        '要复制的行号（长整行）
    Dim rowCopyS As String      '要复制的行号（字符串）
    Dim posPlus As Integer      '加号的位置
    Dim i As Integer
    Dim j As Integer
     
    rowResult = 0
     
    rowSource = 1                     ' 从第1行开始，无标题行
    While Cells(rowSource, 2) <> ""   '先把原来的数据存起来
        ReDim Preserve dataSource(5, rowSource)
        For i = 1 To 5
            dataSource(i, rowSource) = Cells(rowSource, i)
        Next
         
        rowResult = rowResult + 1
        ReDim Preserve dataResult(5, rowResult)
         
        posPlus = InStr(1, dataSource(2, rowSource), "+")   '取得“+”的位置
         
        If posPlus <> 0 And Trim(dataSource(2, rowSource)) <> "+" Then  '本行第二列中含有“+”，且不是“+”
            rowCopyS = Mid(dataSource(2, rowSource), posPlus + 1) '取得“+”后面的数字
            If IsNumeric(rowCopyS) Then     '“+”后面有数字的情况，复制对应行
                rowCopyL = rowSource - 1 - CInt(rowCopyS)
            Else    '“+”后没有数字的情况，复制上一行
                rowCopyL = rowSource - 1
            End If
             
            For i = 1 To 5
                dataResult(i, rowResult) = dataSource(i, rowCopyL)
            Next
            dataResult(2, rowResult) = Mid(dataSource(2, rowSource), 1, posPlus - 1)    '处理第2列数据为“+”前面的内容
             
            rowResult = rowResult + 1
            ReDim Preserve dataResult(5, rowResult)
             
            For i = 1 To 5
                dataResult(i, rowResult) = dataSource(i, rowSource)
            Next
            dataResult(2, rowResult) = "+"    '处理第2列数据为“+”
        Else    '本行第二列中不含有“+”，或者第二列为“+”，原样输出
            For i = 1 To 5
                dataResult(i, rowResult) = dataSource(i, rowSource)
            Next
        End If
     
        rowSource = rowSource + 1
    Wend
     
     
    For i = 1 To rowResult
        For j = 1 To 5
            Cells(i, j + 6) = dataResult(j, i)
        Next
    Next
End Sub

[weixin_44039547]

不好意思，麻烦了