Vba 无法在代码之间设置if语句以使其无错误_Vba_Excel_Web Scraping

Vba 无法在代码之间设置if语句以使其无错误

vba excel web-scraping

Vba 无法在代码之间设置if语句以使其无错误,vba,excel,web-scraping,Vba,Excel,Web Scraping,我编写了一个代码，在下载完成后，在excel表格中设置链接旁边的图片。它工作得很顺利，但问题是每次我运行代码时，它都会被再次下载并在那里解决。因此，如果我删除一张图片，我会在该位置看到另一张。我希望if语句中有一个解决方案，这样，如果应用了，它将省略下载，并在单元格已经填充的情况下进行下一个循环。我来不了。如果有人帮我完成这项任务，我将非常感激。提前谢谢注：链接在B栏，图片在C栏 Sub SetPics() Dim pics As String Dim myPic As Picture Di

我编写了一个代码，在下载完成后，在excel表格中设置链接旁边的图片。它工作得很顺利，但问题是每次我运行代码时，它都会被再次下载并在那里解决。因此，如果我删除一张图片，我会在该位置看到另一张。我希望if语句中有一个解决方案，这样，如果应用了，它将省略下载，并在单元格已经填充的情况下进行下一个循环。我来不了。如果有人帮我完成这项任务，我将非常感激。提前谢谢

注：链接在B栏，图片在C栏

Sub SetPics()

Dim pics As String
Dim myPic As Picture
Dim rng As Range
Dim cel As Range

Set rng = Range("C2", Range("B2").End(xlDown).Offset(0, 1))

    For Each cel In rng
        pics = cel.Offset(0, -1)

        Set myPic = ActiveSheet.Pictures.Insert(pics)    
        With myPic
            .ShapeRange.LockAspectRatio = msoFalse
            .Width = cel.Width
            .Height = cel.Height
            .Top = Rows(cel.Row).Top
            .Left = Columns(cel.Column).Left
        End With    
    Next cel

End Sub

您需要扫描所有形状的

ActiveSheet

（尽量不要使用此选项，并将其替换为

工作表（“YourSheetName”）

）

对于找到的每个形状，如果它等于

cel.Row

则当前图片已经存在（来自此代码以前的运行），并且您不需要“重新插入”图片

代码

Sub SetPics()

Dim pics As String
Dim myPics As Shape
Dim PicExists As Boolean
Dim myPic As Picture
Dim rng As Range
Dim cel As Range

Set rng = Range("C2", Range("B2").End(xlDown).Offset(0, 1))

    For Each cel In rng
        PicExists = False ' reset flag
        pics = cel.Offset(0, -1)

        ' loop through all shapes in ActiveSheet
        For Each myPics In ActiveSheet.Shapes
            If myPics.TopLeftCell.Row = cel.Row Then  ' check if current shape's row equale the current cell's row
                PicExists = True ' raise flag >> picture exists
                Exit For
            End If
        Next myPics

        If Not PicExists Then '<-- add new picture only if doesn't exist
            Set myPic = ActiveSheet.Pictures.Insert(pics)
            With myPic
                .ShapeRange.LockAspectRatio = msoFalse
                .WIDTH = cel.WIDTH
                .HEIGHT = cel.HEIGHT
                .Top = Rows(cel.Row).Top
                .Left = Columns(cel.Column).Left
            End With
        End If
    Next cel

End Sub

Sub-SetPics（）
模糊图片作为字符串
像形状一样暗淡的瞳孔
它以布尔形式存在
像图片一样模糊的myPic
变暗rng As范围
暗淡的cel As范围
设置rng=范围（“C2”，范围（“B2”）。结束（xlDown）。偏移量（0，1））
对于rng中的每个cel
PicExists=False“重置标志
pics=单元偏移（0，-1）
'循环浏览ActiveSheet中的所有形状
对于ActiveSheet.Shapes中的每个myPics
如果myPics.TopLeftCell.Row=cel.Row，则“检查当前形状的行是否与当前单元格的行相等”
PicExists=True“升起标志>>图片存在
退出
如果结束
下一个myPics
如果不存在，则“您需要扫描所有形状的ActiveSheet
（尽量不要使用此选项，并将其替换为工作表（“YourSheetName”）
）
对于找到的每个形状，如果它等于
cel.Row
则当前图片已经存在（来自此代码以前的运行），并且您不需要“重新插入”图片
代码
Sub SetPics()

Dim pics As String
Dim myPics As Shape
Dim PicExists As Boolean
Dim myPic As Picture
Dim rng As Range
Dim cel As Range

Set rng = Range("C2", Range("B2").End(xlDown).Offset(0, 1))

    For Each cel In rng
        PicExists = False ' reset flag
        pics = cel.Offset(0, -1)

        ' loop through all shapes in ActiveSheet
        For Each myPics In ActiveSheet.Shapes
            If myPics.TopLeftCell.Row = cel.Row Then  ' check if current shape's row equale the current cell's row
                PicExists = True ' raise flag >> picture exists
                Exit For
            End If
        Next myPics

        If Not PicExists Then '<-- add new picture only if doesn't exist
            Set myPic = ActiveSheet.Pictures.Insert(pics)
            With myPic
                .ShapeRange.LockAspectRatio = msoFalse
                .WIDTH = cel.WIDTH
                .HEIGHT = cel.HEIGHT
                .Top = Rows(cel.Row).Top
                .Left = Columns(cel.Column).Left
            End With
        End If
    Next cel

End Sub

Sub-SetPics（）
模糊图片作为字符串
像形状一样暗淡的瞳孔
它以布尔形式存在
像图片一样模糊的myPic
变暗rng As范围
暗淡的cel As范围
设置rng=范围（“C2”，范围（“B2”）。结束（xlDown）。偏移量（0，1））
对于rng中的每个cel
PicExists=False“重置标志
pics=单元偏移（0，-1）
'循环浏览ActiveSheet中的所有形状
对于ActiveSheet.Shapes中的每个myPics
如果myPics.TopLeftCell.Row=cel.Row，则“检查当前形状的行是否与当前单元格的行相等”
PicExists=True“升起标志>>图片存在
退出
如果结束
下一个myPics
如果不存在PICO，那么“这应该是可行的，但这是一个相当低效的O（n^2）解决方案。”。更好的解决方案是迭代形状一次，将每个形状的行
存储在字典
键中，然后您可以使用字典.Exists（cel.Row）
进行O（1）查找，而不是迭代范围内每个单元格的每个形状。谢谢，Shai Rado。你是一个男人的珍宝。现在它完美无缺了。再次感谢。亲爱的马特先生的杯子，如果你有时间的话，我也能有你的高效杯子就好了。谢谢。这应该行得通，但这是一个效率很低的O（n^2）解决方案。更好的解决方案是迭代形状一次，将每个形状的行
存储在字典
键中，然后您可以使用字典.Exists（cel.Row）
进行O（1）查找，而不是迭代范围内每个单元格的每个形状。谢谢，Shai Rado。你是一个男人的珍宝。现在它完美无缺了。再次感谢。亲爱的马特先生的杯子，如果你有时间的话，我也能有你的高效杯子就好了。谢谢