Excel的合并删除宏

时间:2012-02-04 23:23:04

标签: excel excel-vba vba

我有一张excel电子表格,其中包含各种电视节目的成绩单。正如您所看到的,每次发言者改变时,它们都被称为“BURNETT:”或“HANNITY:”。我需要一种方法来合并跟随特定扬声器的所有单元格,以便它们的语音全部包含在一个Excel单元格中。我尝试将文本到列保存为CSV并进行查找替换,但当然这不起作用。

例如,我需要这个......

NETWORK SHOW    DATE    TIME    TIMEBLOCK   SPEAKER SPEAKTURN
CNN OUTFRONT    2011-12-05  19:00   19:00           ERIN BURNETT OUTFRONT
CNN OUTFRONT    2011-12-05  19:00   19:00           ERIN BURNETT, HOST: Thanks, John. We're live from the Middle East…
CNN OUTFRONT    2011-12-05  19:00   19:00           Let's go OUTFRONT.
CNN OUTFRONT    2011-12-05  19:00   19:00           I'm Erin Burnett and I'm OUTFRONT tonight live from Abu Dhabi in…
CNN OUTFRONT    2011-12-05  19:00   19:00           Now Iran claims that it shot down an American drone that looks a…
CNN OUTFRONT    2011-12-05  19:00   19:00           If this really happened, that means that technology is in the han…
CNN OUTFRONT    2011-12-05  19:00   19:00           So far recently we've had Israel threatening to bomb Iranian nucl…
CNN OUTFRONT    2011-12-05  19:00   19:00           Iran is defiant, and a defiant Iran could mean surging oil prices…
CNN OUTFRONT    2011-12-05  19:00   19:00           Robin Mills is author of "The Myth of the Oil Crisis". Riad Kahwa…
CNN OUTFRONT    2011-12-05  19:00   19:00           RIAD KAHWAJI, FOUNDER, INST. MILITARY ANALYSIS: Well, I think…
CNN OUTFRONT    2011-12-05  19:00   19:00           BURNETT: Teetering.

成为这个......

NETWORK SHOW    DATE    TIME    TIMEBLOCK   SPEAKER  SPEAKTURN
CNN OUTFRONT    2011-12-05  19:00   19:00            ERIN BURNETT OUTFRONT
CNN OUTFRONT    2011-12-05  19:00   19:00            ERIN BURNETT, HOST: Thanks, John. <<all the intervening text in the rows in between>> Robin Mills is author of "The Myth of the Oil Crisis." Riad Kahwa…
CNN OUTFRONT    2011-12-05  19:00   19:00            RIAD KAHWAJI, FOUNDER, INST. MILITARY ANALYSIS: Well, I think…
CNN OUTFRONT    2011-12-05  19:00   19:00            BURNETT: Teetering.

看看Erin Burnett的演讲现在如何包含在一个单元格内,其他行已被删除?我需要一个宏来做到这一点。

从那里,我可以通过使用文本到列功能并删除SPEAKER列中没有名称的所有行来使其看起来像这样。这将是最终目标,但我可以做这些步骤(是的,我知道,给你留下难点)。

NETWORK SHOW    DATE    TIME    TIMEBLOCK   SPEAKER                                               SPEAKTURN
CNN OUTFRONT    2011-12-05  19:00   19:00   ERIN BURNETT, HOST                                    Thanks, John. <<intervening text>> Robin Mills is author of "The Myth of the Oil Crisis." Riad Kahwa…
CNN OUTFRONT    2011-12-05  19:00   19:00   RIAD KAHWAJI, FOUNDER, INST. FOR MILITARY ANALYSIS    Well, I think…
CNN OUTFRONT    2011-12-05  19:00   19:00   BURNETT                                               Teetering.

工作表,如果您愿意,可以在Wikisend下载到下周。

对于它的价值,我很确定任何识别单元格引入新发言者的脚本都需要看到至少有四个连续的大写字母最终跟随冒号(我说最终,因为他们第一次讲的头衔和职业)。然后它可以向下看列,直到它找到另一个这样的单元格。然后,它将连接“找到的”单元格之间所有单元格的内容(在每个单元格之间插入空格),并删除不再包含任何SPEAKTURN数据的行。

最后,我应该道歉。我知道Stackoverflow的期望是我应该进行充分的研究,但是我要在截止日期前完成,而且我不知道还能在哪里转。我学会了如何在上个学期的一个月里绊倒我的路,但作为政治科学主要的出路,我不能为我的生活学习足够的VBA在星期二之前做到这一点。 ::垂头丧气::

如果没有宏来做这件事,我将花费几天时间合并超过8,000个单元格。我很绝望。如果你想要补偿 - 我是一个贫穷的大学生,正在尝试做一个沟通高级项目---我会尽我所能。我只是在我的智慧结束。

PS如果你想知道为什么我需要这个...好吧,我将为电视节目主持人存在或不存在13种类型的操纵策略的每个演讲轮次进行评分:(1)侮辱性语言,( 2)名字呼唤,(3)情感表达,(4)情感语言,(5)口头战斗/陪练,(6)性格暗杀,(7)歪曲夸张,(8)嘲讽/讽刺,(9)大火,( 10)意识形态极端化的语言,(11)滑坡论证,(12)贬低,(13)淫秽语言。这一切都与有线电视新闻节目如何让人们感到愤怒有关。 8000行需要一段时间,这就是为什么我非常渴望你的帮助。

2 个答案:

答案 0 :(得分:1)

没有多少人会帮助你,你没有提供最少的vba代码来表明你的知识水平或你至少尝试过。另外,你说这是为了学校,大多数都不帮助学生做功课。

我至少会向您概述如何完成任务:

set excelapp = excel.application
set objwb = excelapp.workbooks.open("C:\yourworkbook.xls")
set objws = objwb.worksheets("yourworksheet")
set newObjws = objwb.worksheets.add()

dim newRow as long
newRow = 1
sc = speechColumn --- you need to insert its number here

for i = 1 to objws.usedrange.rows.count
      newobjws.cells(newrow,sc).value = objws.cells(i,sc)
      'here you would want to copy other columns if you like as well.
      i = i + 1
      do while instr(objws.cells(i,sc).value,":") = 0
            newobjws.cells(newrow,sc).value = newobjws.cells(newrow,sc).value & _
                                              " " & objws.cells(i,sc).value
            'here you would want to copy other columns if you like as well.
            i = i + 1
      loop
      i = i - 1
next i

答案 1 :(得分:0)

Wikisend网站包含一个zip文件CleanMS.zip,其中包含许多XML文件。我将“sharedStrings.xml”导入Excel。 C列与图像中的SPEAKTURN列匹配。

我已经测试了你的理论,如果四个字符大写并且字符串中有一个冒号,那么直到冒号的字符就是一个名字。我这样做是通过找到这样的字符串并在另一张“名字”表中创建一个新列表。有5500这样的“名字”,我找不到任何看起来不像名字。这总共有8,264行。

以你想要的方式合并线条是微不足道的。

然而,最后你有两个明显的“主持人”:Bret BAIER和Ed HENRY。有如下行:

HENRY (on-camera): Senior officials privately say the last ... -- Bret
About an hour ago, we learned the S&P rating service ...

HENRY或BAIER的第二行是什么?

如果您希望我更仔细地查看您的数据,您需要将其作为XLS文件提供。

顺便说一下,午夜到了这里,所以我要去睡觉了。如果您回复,请不要期待在接下来的8-9个小时内回复。

新版

我意识到,当我通过轻微的调整睡觉时,我的调查代码几乎提供了你所要求的所有内容,也许你需要的所有内容。

更改两个Const语句以寻址正确的列,此代码将从SPEAKTURN列中删除该名称并将其放入SPEAKER列。

当扬声器有两行或更多行时,这不合并文本,但我认为结果就是你所寻求的。我已经对我设法从Excel导入的数据进行了测试,但未在原始工作表上进行测试,因此在运行此代码之前保存数据。

Sub ExtractNames()

  Dim PosColon As Long
  Dim RowCrnt As Long
  Dim RowLast As Long
  Dim Stg As String

  ' ##### Replace "C" and "B" with the correct columns
  Const ColSpeakTurn As String = "C"
  Const ColSpeaker As String = "B"

  With Sheets("Sheet1")
    RowLast = .Cells(Rows.Count, ColSpeakTurn).End(xlUp).Row

    For RowCrnt = 1 To RowLast
      Stg = .Cells(RowCrnt, ColSpeakTurn).Value
      PosColon = InStr(1, Stg, ":")
      If PosColon <> 0 Then
        If UCase(Left(Stg, 4)) = Left(Stg, 4) Then
          ' Looks like a name.
          ' Copy name to Speaker column
          .Cells(RowCrnt, ColSpeaker).Value = Mid(Stg, 1, PosColon - 1)
          ' Remove name and any following spaces from SpeakTurn column
          .Cells(RowCrnt, ColSpeakTurn).Value = Trim(Mid(Stg, PosColon + 1))
          RowCrnt = RowCrnt + 1
        End If
      End If
    Next

  End With

End Sub