Excel宏搜索特定排列的值,可能吗?

时间:2013-03-31 00:23:20

标签: excel vba

这就是我的困境,我需要为36张不同的专辑解析一系列价值606周的Billboard 200排行榜。这是我到目前为止所得到的......

https://docs.google.com/file/d/0B_tgNfDq0kXAakR5eHZ3bzJQVkk/edit?usp=sharing

Billboard只是重新编写了他们的网站,所以现在Excel的webquery返回一个非常漂亮和干净的表。我在工作表的A列和B列中创建了两个公式,A列出了相关日期(特别是从2002年8月18日到本周的每个星期六),B根据日期创建了超链接。图表的其余部分采用颜色编码,以便我的顾问受益,他们也将审查表格。

我还手动将第一张图表(2001-08-18)写入自己的工作表。这个工作表没有被触及 - 它正是webquery返回的内容。

如您所见,该表跨越到G列,每个条目占用3行。我的重点是列C和D.每个条目的列D行是(从上到下)标题,艺术家和印记|标签。每个条目的C列中的第一行包含该周的位置,从1到200.出现的模式是每个以4开头的第3行(所以7,10,13 ......)包含位置和专辑标题(col C & D,resp。),以5开头的每个第3个单元格都包含一个艺术家。

我将尝试用简单的英语解释我的想象,但要预先警告这可能会失败。

因此宏会将两个单元格作为输入(甚至可以输入?),专辑标题和相应的艺术家。该输入应该告诉宏存储在每个单元中的字符串和所述单元的位置 - 例如E1,C2。宏应循环遍历第3行到第608行中的每个URL,并将URL查询到新工作表中。应该激活这个新工作表,然后按顺序搜索每个以4开头的第3行作为相册标题字符串。找到匹配后,匹配查询单元格下方的一行单元格应与艺术家名称字符串进行比较。如果两个字符串都匹配其相应查询单元格的内容,则应将C列中的数字(从1到200)和与匹配的专辑标题单元格相同的行复制到与所查询的URL对应的“bb200”表单中的单元格中并搜索了专辑标题。循环现在应该重复序列中的下一个URL。如果没有找到匹配(相册没有绘制那一周的图表,或者BB返回了一张不稳定的表格),相应的单元格应该留空。一旦URL列表用尽,宏就应该退出。

我的问题有两个方面:首先,关于宏的基本声音的思考过程是什么?第二,但最重要的是,我还没有最微弱的线索,甚至开始在VBA中写这个。我研究过Java,C和最近的C ++(特别是OpenGL)。我完全不熟悉VBA语法和API,坦率地说,我在这方面的时间太短,无法坐下来正式学习语言。在此之后,我计划在短时间内这样做,但这项任务将于周一到期,我不知道它最终会有多大的承诺。

对于记录,宏不是赋值,但要收集的数据是完成它的必要条件。对于那些好奇的人来说,任务是在星期一之前完成我的高级论文的完整草稿。这些数据将用于创建我的顾问指示我在写作中包含的几个图表。本文的编写基于简单地阅读每个专辑在网站上的销售业绩。

你将帮助我超越,因为大多数其他毕业的老年人正在转向一些严重的半生不熟的图形表示。迄今为止唯一的其他学生发明了一种仪器并提供了原理图和autoCAD图纸。但是,我就离题了。

提前感谢您的帮助!!

1 个答案:

答案 0 :(得分:3)

我认为这应该可以让你达到90%左右。唯一不做的是网页查询。

对于那部分,我建议您使用宏录制器进行Web查询,然后将该代码发布到修订版中,我们将其添加并根据您的需要进行定制。你必须做一些工作:)

Option Explicit

Sub TestMacro()
Dim inputVal As String
Dim artistCell As Range
Dim artistName As String
Dim albumCell As Range
Dim albumName As String
Dim ws As Worksheet: Set ws = Sheets("thesisData")
Dim r As Long 'this will be our row iterator variable
Dim hLink As String 'string for each hyperlink in the iteration
Dim wsNew As Worksheet 'this will be used when we create new worksheets
Dim foundRange As Range 'this is how we will locate the album
Dim weekRank As Long 'weekly rank from column C


On Error GoTo InvalidRange  'This error handling is for the input box, to trap invalid arguments.'
'Use an input box to capture the cell address'
inputVal = InputBox("Please enter the cell location containing the ARTIST name", "Input Range")
Set artistCell = Range(inputVal)  'set a Range variable for the artist'
artistName = artistCell.Value  'string variable for artist name'

inputVal = vbNullString 'clear out the inputVal'
'Use an input box again...'
inputVal = InputBox("Please enter the cell location containing the ALBUM name", "Input Range")
Set albumCell = Range(inputVal)  'set a Range variable for the song cell'
albumName = albumCell.Value  'string for song name'
On Error GoTo 0

For r = 3 To 608  'iterate over rows 3 to 608
    hLink = ws.Cells(1, r).Value

    'Add a new sheet after the last sheet in this file'

    Set wsNew = Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
    wsNew.Name = Format(ws.Cells(r, 2).Value, "YYYY-MM-DD")

    '''' add VBA for web query, here.'
    ''''
    '''' try using the macro recorder and we can tweak it to your needs.'
    ''''
    ''''
    ''''

    'Rather than looping over all the cells in web query...'
    Do
        'Use the FIND method to look for matching album title in column D.'
        ' this uses exact text match, non-case-sensitive.
        Dim fnd

        Set foundRange = wsNew.Columns(4).Find(What:=albumName, After:=ActiveCell, LookIn:= _
            xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
            xlNext, MatchCase:=True, SearchFormat:=False)

        If Not foundRange Is Nothing Then
            'if we've found a match, then just offset by 1 row and check against artist name'
            If foundRange.Offset(1, 0) = artistName Then
                'likewise, just offset the foundRange cell by -1 columns to get the weekly rank'
                weekRank = foundRange.Offset(0, -1)

                'At this point I'm not sure what cell you want to put this value in, '
                ' but I think you want row designated by "r" and the column of the '
                ' album name, so we can do that like this:

                ws.Cells(r, albumCell.Column).Value = weekRank

            End If
        End If
    Loop While Not foundRange Is Nothing


Next

Exit Sub 'before error handling
InvalidRange:     'error handling

MsgBox inputVal & " is not a valid range", vbCritical, "Error!"

End Sub
祝你好运!

编辑这也假设每个网络查询中只会有一个匹配项。如果有多个,它只会返回最后一场比赛。考虑到数据的性质,这似乎是一个安全的假设,但如果情况并非如此,请告诉我,我可以调整它。