Макрос Excel для разбора строк / столбцов на новый лист

#vba #excel

#vba #excel

Вопрос:

В настоящее время у меня есть огромный лист (Лист1), содержащий несколько строк (максимум в Excel), и я хотел бы разобрать это на наборы из 276 строк / столбцов на отдельный лист с заголовками.

Заголовки для листа 2 будут поступать из столбца A (который повторяется 276 раз, поэтому его нужно выбрать только один раз), в то время как данные находятся в C и D.

Я попытался записать макрос с помощью VBA, но у меня нет знаний для редактирования в цикле для всех строк.

Это кажется полезным, но это не совсем так. https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/parse-functions/columns-to-sheets

Макрос, который я записал:

     Sub snp()
    '
    ' snp Macro
    ' transpose snp
    '
    ' Keyboard Shortcut: Ctrl q
    '
        Sheets("Sheet1").Select
        Range("C24566").Select
        Application.Goto Reference:="R24566C3:R24841C4"
        Selection.Copy
        Sheets("Sheet2").Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select
        ActiveWindow.SmallScroll Down:=252
        Range("A24841").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Sheet2").Select
        Range("FX1").Select
        ActiveSheet.Paste
    End Sub
  

но этот макрос просто делает одно и то же снова и снова (потому что у меня нет НИКАКИХ знаний о макросах, чтобы знать, как заставить его перейти к следующему набору 276 …).

Помогите? Спасибо!

Ответ №1:

Следующий код делает несколько предположений:

  1. У вас нет других листов, кроме «Sheet1»
  2. Можно называть все будущие листы «SheetX»
  3. Копируется только столбец A
  4. Не имеет значения, что на последнем листе скопированы дополнительные пробелы
  5. После того, как вы запустите его один раз, вам не нужно будет запускать его снова (он больше не будет работать)
  6. У вас нет заголовков на исходном листе (лист1) или на любом из листов, на которые он копируется

Адаптируйте это в соответствии с вашими потребностями, но это должно помочь вам начать

 Sub Parse()

Dim SheetNum As Integer
Dim Par As Range
SheetNum = 2

Do While Sheets("Sheet1").Range("A1") <> ""

Sheets.Add.Name = "Sheet" amp; SheetNum

X = Sheets("Sheet1").Range("A1").Offset(256, 0).Address

Sheets("Sheet1").Range("A1:" amp; X).Copy

Sheets("Sheet" amp; SheetNum).Range("A1").PasteSpecial

Sheets("Sheet1").Rows("1:256").Delete

SheetNum = SheetNum   1

Loop


End Sub
  

Я просто подумал, что расширю этот ответ, чтобы вы чему-то научились из него и могли развить свои навыки VBA:

Do While Sheets("Sheet1").Range("A1") <> "" Это начинается loop с условием, что loop будет выполняться до тех пор, пока диапазон на листе 1 не будет равен Empty

Sheets.Add.Name = "Sheet" amp; SheetNum Добавляет новый лист с номером листа

 X = Sheets("Sheet1").Range("A1").Offset(256, 0).Address

Sheets("Sheet1").Range("A1:" amp; X).Copy

Sheets("Sheet" amp; SheetNum).Range("A1").PasteSpecial

Sheets("Sheet1").Rows("1:256").Delete
  

X устанавливается в качестве адреса и затем копируется, затем вновь созданный лист вставляется в скопированные ячейки. Затем исходные ячейки удаляются.

SheetNum = SheetNum 1 Увеличьте номер листа на единицу, прежде чем перейти к loop команде, и продолжайте цикл, пока не будут установлены критерии.