（已关闭）求助一下大佬

中三洛水

获取D列 红色字符的位置 然后去A列获取位置的字符 返回到B列
同事告诉我只需要函数处理 但是我感觉需要用VBA去处理 版本是2019 烦请诸位高手大佬指点一二

ykcbf1100

附件供参考。。。

ykcbf1100

根据字体颜色来确定提取字符的位置。

1. Sub ykcbf()   '//2024.8.5
   
2.     r = Cells(Rows.Count, 4).End(3).Row
   
3.     [b1].Resize(r) = ""
   
4.     For i = 1 To r
   
5.         Set Rng = Cells(i, 4)
   
6.         s = Rng.Value
   
7.         For x = 1 To Len(s)
   
8.             If Rng.Characters(x, 1).Font.ColorIndex = 3 Then
   
9.                 m = x
   
10.                 Cells(i, 2) = Mid(Cells(i, 1), m, 1)
    
11.             End If
    
12.         Next
    
13.     Next
    
14.     MsgBox "OK！"
    
15. End Sub
    

复制代码

中三洛水

ykcbf1100 发表于 2024-8-5 18:38
附件供参考。。。

多谢大佬 多谢大佬的技术

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&, r&
   
    r = Cells(Rows.Count, "A").End(xlUp).Row
   
    With Range("A1:A" & r)
        ar = .Value
        ReDim br(1 To UBound(ar), 0)
        For i = 1 To UBound(ar)
            If Len(ar(i, 1)) Then
                With .Cells(i, 1).Offset(, 3)
                    For j = 1 To Len(.Value)
                        If .Characters(j, 1).Font.ColorIndex = 3 Then
                           br(i, 0) = Mid(ar(i, 1), j, 1): Exit For
                        End If
                    Next j
                End With
            End If
        Next i
        .Offset(, 1).Value = br
    End With
   
    Beep
End Sub

gwjkkkkk

。。。。。。。。。。

无关岁月

1. =IFNA(VLOOKUP("虎",MID(D1&A1,ROW($1:$6)+{0,6},1),2,),"")

复制代码

ykcbf1100

无关岁月 发表于 2024-8-5 19:07

用公式的话有点投机了。正常应该按红色为条件去提取。

无关岁月

ykcbf1100 发表于 2024-8-5 19:33
用公式的话有点投机了。正常应该按红色为条件去提取。

这我知道啊，我看他的例子正好有这个规律，就随手一写

ykcbf1100

无关岁月 发表于 2024-8-5 19:39
这我知道啊，我看他的例子正好有这个规律，就随手一写

也是。。。