vba中怎么遍历单元格中所有字符串

Posted 2023-04-12

vba中怎么把单元格中所有字符串带reqdate（忽略大小写）的标红，小白一个，我的代码买次只遍历一次，因为只有一个if语句。

答：

Sub Demo()
    Dim rng As Range
    Dim mMatches As Object, mMatch As Object
    For Each rng In Range("E1:E300")
        With CreateObject("VBSCRIPT.REGEXP")
            .Global = True
            .Pattern = "reqdate"
            .IgnoreCase = True
            Set mMatches = .Execute(rng.Text)
            For Each mMatch In mMatches
                rng.Characters(mMatch.FirstIndex + 1, 7).Font.ColorIndex = 3
            Next
        End With
    Next
End Sub

实测效果图：

参考技术A

i=instr(cells(6,1),"-")
j=len(cells(6,1))-i
cells(6,7)=mid(cells(6,1),i,j)

使用VBA在Excel填充单元格中插入多个图像，但保持宽高比

我设法找到将多个图像一次性插入到一列单元格（预定义大小）中的VBA代码。

但是，图像由横向和纵向组成。我想将宽高比锁定为单元格高度。有什么办法吗？对于纵向肖像图像，将其拉伸到像元的水平尺寸时，尤其是一个问题。

理想情况下，将所有长宽比保持不变，以像元高度为基准。

非常感谢！

选择第一个单元格时的我的代码：

Sub InsertPictures()
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
    xRowIndex = Application.ActiveCell.Row
    For lLoop = LBound(PicList) To UBound(PicList)
        Set Rng = Cells(xRowIndex, xColIndex)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        xRowIndex = xRowIndex + 1
    Next
End If
End Sub

答案

使用sShape.LockAspectRatio = msoCTrue锁定图像的纵横比，然后重设形状高度。但是，它不能保证图像的质量。最好的方法是保持所有图像的原始大小相似，以获得更好的效果。