我正在尝试编写一些VBA来帮助比较一些数据

时间:2015-12-15 17:24:07

标签: excel vba excel-vba

编辑:

根据下面的建议,我尝试了以下关于应该粘贴一些数据的样本数据;它没有错误,但它也没有粘贴数据:

Public Sub MakeCompareSheet()

Dim i As Long
Dim rCell As Range
Dim shBuild As Worksheet
Dim shComp As Worksheet

Set shBuild = Sheets("Builds")
Set shComp = Sheets("Build Compare")

For i = 2 To 8 Step 2 'cols B through H

    'loop through row 1 of the builds sheet
    For Each rCell In shBuild.Range("A1" & Columns.Count).Cells
        'if row 1 of builds = row 1, column i of comps
        'and if the cell below equals the cell below
        If rCell.Value = shComp.Cells(1, i).Value And rCell.Offset(1, 0).Value = shComp.Cells(2, i).Value Then

            'copy row 3 down 166 rows to the comps wheet
            rCell.Offset(2, 0).Resize(166, 1).Copy shComp.Cells(3, i)

            'Since we already found it, we don't need to look anymore
            Exit For
        End If
    Next rCell
Next i

End Sub

编辑#2:

当我回到原始代码时,它会出错。我怀疑这是因为它搜索的第一件事可以在多个单元格中找到。

例如,AAA ###位于Range中的6个单元格中。我不确定为什么当我使用Columns.Count时它不​​会出错但是使用的是硬范围。

编辑#3:

以上代码无法正常工作,将范围设置为超出ZZ1也会破坏它。我将不得不让他们知道,当我们接近ZZ时,我们需要一张新工作表重新开始。

编辑#4:

Public Sub MakeCompareSheet()

Dim i As Long
Dim rCell As Range
Dim shBuild As Worksheet
Dim shComp As Worksheet

Set shBuild = Sheets("Builds")
Set shComp = Sheets("Build Compare")

If IsEmpty(shComp.Cells(1, 2)) = True Then
    MsgBox ("Please enter at least 1 build ID into Cell B1")
    Else
    If IsEmpty(shComp.Cells(2, 2)) = True Then
        MsgBox ("Please enter the phase for the build")
    End If
End If

    For i = 2 To 8 Step 2 'cols B through H

            'loop through row 1 of the builds sheet
            For Each rCell In shBuild.Range("A1").Resize(1, shBuild.Columns.Count).Cells
                'if row 1 of builds = row 1, column i of comps
                'and if the cell below equals the cell below
                If rCell.Value = shComp.Cells(1, i).Value And rCell.Offset(1, 0).Value = shComp.Cells(2, i).Value Then
                    If IsEmpty(rCell) Then GoTo 34 Else
                    'copy row 3 down 166 rows to the comps sheet
                    rCell.Offset(2, 0).Resize(166, 1).Copy shComp.Cells(3, i)

                    'Since we already found it, we don't need to look anymore
                Exit For
            End If
        Next rCell
34:     Next i

End Sub

这就是现在的代码,运行良好。非常感谢迪克提供的所有帮助;我真的很感激。

1 个答案:

答案 0 :(得分:0)

我不确定将这些值放在变量中是可行的方法。在下面的示例中,它读取每个comps单元格,在构建中找到该单元格,然后复制数据。

def get_links(url):
    html = urlopen(url)
    bsObj = bs(html)
    for link in bsObj.find_all('a', href=re.compile("^(http://www1.folha.uol.com.br/)(.)*$")):
        if 'href' in link.attrs:
            if link.attrs['href'] not in urls:
                urls.add(link.attrs['href'])
                to_crawl.add(link.attrs['href'])
    if bsObj.find(attrs={'itemprop':'articleBody'}):
        articles.add(url)
        page_append(url)
        print(url)
    urls_crawled.add(url)