Слияние-удаление макроса для Excel

Question

У меня есть таблица 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.

Посмотрите, как говорящий ход Эрин Бернетт теперь содержится в одной ячейке, а другие строки были удалены?Мне нужен макрос, который делает это.

Оттуда я могу заставить его выглядеть так, используя функцию преобразования текста в столбцы и удаляя все строки, которые не имеют имени в столбце 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 ожидают, что я проведу обширные исследования, но я подхожу к крайнему сроку и не знаю, куда еще обратиться.Я узнал, как спотыкаться на своем пути через R в течение месяца в прошлом семестре, но, как политолог, главный выход из моей лиги, я не могу за всю жизнь выучить достаточно VBA, чтобы сделать это ко вторнику.:: опустив голову в стыде ::

Без макроса, чтобы сделать это, мне придется потратить несколько дней, объединяя более 8000 ячеек.Я в отчаянии.Если вы хотите получить компенсацию - я плохой выпускник колледжа и пытаюсь сделать проект для старших по связям - я сделаю все возможное.Я просто нахожусь в своем уме.

PS Если вы хотите знать, зачем мне это нужно ... ХОРОШО, я буду оценивать каждый из выступающих за наличие или отсутствие 13 типов манипуляций.Тактика ведущими телешоу: (1) оскорбительный язык, (2) называние имени, (3) эмоциональные проявления, (4) эмоциональный язык, (5) словесные драки / спарринг, (6) убийство персонажа, (7) искаженное преувеличение,(8) издевательство / сарказм, (9) конфликт, (10) идеологически экстремизирующий язык, (11) аргументы скользкого склона, (12) принижение и (13) нецензурная лексика.Это все о том, как кабельные новостные шоу раздражают людей.8000 строк этого займут некоторое время, поэтому я так отчаянно нуждаюсь в вашей помощи.

Answer 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

Answer 2

Сайт Wikisend содержит ZIP-файл CleanMS.zip, который содержит несколько файлов XML. Я импортировал «sharedStrings.xml» в Excel. Столбец C соответствует столбцу SPEAKTURN на изображении.

Я проверил вашу теорию, что если четыре символа пишутся с большой буквы и в строке есть двоеточие, то символы до двоеточия - это имя. Я сделал это, найдя такие строки и создав новый список на другом листе «имен». Есть 5500 таких «имен», и я не могу найти ни одного, которое не похоже на имя. Это из 8 264 строк.

Объединение строк так, как вы ищете, было бы тривиально.

Однако в самом конце у вас есть два очевидных "хозяина": Брет Байер и Эд Генри. Есть такие строки, как:

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

Вторая строка от ГЕНРИ или БАЙЕРА?

Если вы хотите, чтобы я посмотрел на ваши данные более тщательно, вам необходимо предоставить их в виде файла 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