Сценарий Excel VBA для создания нового листа и редактирования формул соответственно. Vba excel создать новый лист

Excel VBA - Создание нового листа с категориями и строками между

Цель: иметь макрос, который имеет строки с содержимым в одном листе, разделенные пустыми строками, в зависимости от значений других листов. Вот как конечный результат должен выглядеть следующим образом:

Ситуация сейчас (руководство): Я хожу в лист 3, увидеть, какие категории существуют, и добавить их вручную на листе 1 с красным фоном. После этого я иду на лист 2, посмотреть, сколько существует подпункты для каждой категории, а также добавить, что многие строки вручную в листе 1.

Изображение Лист 2:

Изображение листа 3 (Категория)

Ситуация с Macro: Я бег макроса, который затем создает категории, основанные на листе 3, и с пустыми строками между этими категориями на основе # элементов в листе 2.

Вот мой код до сих пор:

Sub AddingCategories() ' ' AddingCategories Macro ' ' here we copy the categories from the Categories sheet Sheets("Categories").Select 'we select the sheet where the categories are Range("A1").Select 'we select the first cell with content Range(Selection, Selection.End(xlDown)).Select 'we can select all categories with content Application.CutCopyMode = False Selection.Copy 'we copy the content Sheets("Timeschedule2").Select 'we go to the destination sheet Range("B11").Select 'We select the first row where we want content ActiveSheet.Paste 'Here we format them to red Range("A11:B25").Select 'since we just copied content, we need to have the cells with the formatting we want (in this case red) Application.CutCopyMode = False With Selection.Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection.Font .ColorIndex = xlAutomatic .TintAndShade = 0 End With 'Here we delete all rows without content Range("B11:B30").Select Selection.SpecialCells(xlCellTypeBlanks).Select ActiveWindow.SmallScroll Down:=-6 Selection.EntireRow.Delete 'Here we add the rows. Since we want to specify a number of rows to add, we first calculate this value using a countif function 'this will tell us how many rows we need to add and we have it in Categories!C1. To add that many rows, we use a loop For i = 1 To Worksheets("Categories").Range("C1") Worksheets("Timeschedule2").Select Rows("12:12").Select Selection.Insert With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Next i End Sub

С помощью этого кода, я очень гордо создал категории и удалось создать количество строк для первой категории. Моя проблема в том, что я не знаю, как создать цикл, который сделает это для всех категорий автоматически (чтобы сделать первый, я указал, чтобы добавить их для строки 12:12, но у меня нет способа узнать в заранее, где они должны добавить следующие новые строки, а также сколько раз цикл, так как количество категорий будет меняться от проекта к проекту) Я искал с Do до IsEmpty, Do While, For и т. д., но я раю не удалось понять это.

Как бы вы это сделали? Как я могу улучшить свой существующий код?

Я знаю, что мой код, вероятно, очень нелогичен, извиняется за это! Мне в первую очередь интересно узнать, как программировать VBA больше, чем делать этот конкретный макрос, поэтому, если бы вы могли объяснить мне, как будто я был не программистом 5-летним, я был бы благодарен.

stackoverrun.com

Пытается создать макрос excel vba, который открывает новый лист, переименовывает его в соответствии со значением относительной ячейки в исходном листе

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

Открыть конкретный шаблон листа Дайте ему имя, которое = значение ActiveCell или первой ячейки активируется в макро и копировать и пасты информацию от мастера список на новый лист открыт

Я могу выяснить, как открыть лист и выполнить копию и вставить, но я всегда получаю сообщение об ошибке при переименовании листа.

ActiveCell.Range("A1,A2:B26").Select ActiveCell.Offset(1, 0).Range("A1").Activate ActiveWindow.ScrollRow = 5 ActiveWindow.ScrollRow = 4 ActiveWindow.ScrollRow = 3 ActiveWindow.ScrollRow = 2 ActiveWindow.ScrollRow = 1 ActiveCell.Offset(-1, 0).Range("A1").Select Sheets("Patient List").Select Sheets.Add Type:= _ "C:\Users\Valerie\AppData\Roaming\Microsoft\Templates\Patient-History-Template1.xltx" Sheets("Patient List").Select Selection.Copy Sheets("Patient List").Select Sheets("Patient List").Name = "Patient List" Sheets("Patient 1").Select

Ниже здесь, где я хотел бы, чтобы имя нового листа = относительное значение первой ячейки активированной в макрос вместо «Джонс». Таким образом, я могу запустить макрос и получить отдельные листы для каждого имени в столбце А.

Sheets("Patient 1").Name = "Jones" Sheets("Jones").Select ActiveSheet.Paste Sheets("Patient List").Select ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Sheets("Jones").Select ActiveCell.Offset(0, 1).Range("A1").Select ActiveSheet.Paste Sheets("Patient List").Select ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Sheets("Jones").Select ActiveCell.Offset(2, -1).Range("A1").Select ActiveSheet.Paste Sheets("Patient List").Select

stackoverrun.com

vba - excel для создания нового листа для каждой строки

Начну с того, что вы должны быть осторожны с этим, поскольку существует ограничение на количество листов в книге. Но вот какой-то код в vb. Это должно дать вам логику, чтобы сделать это в vba. Будет только некоторая разница в обращении к листу и, возможно, к ячейкам.

Вам нужно будет объявить рабочий лист, который вы читаете

Dim ws As Excel.Worksheet Set ws = ea.Worksheets(1)

Он может начинаться с индекса листа 0, поэтому Set ws = ea.Worksheets(0) Или есть что-то вроде Excel.Application.Activsheet

Вот логика, чтобы перебрать строки и проверить значение столбца A.

dim lRow as integer Do While lRow <= ws.UsedRange.Rows.Count If ws.Range("A" & lRow).Value <> "" Then Then 'If cell A is not blank we then call the worksheet add function. 'Pass the name you want the worksheet and the page setup arguments. WorksheetAdd ws.Range("A" & lRow).Value, xlPaperLetter, xlPortrait ws.name = ws.Range("A" & lRow).Value End If lRow = lRow + 1 ws.Range("A" & lRow).Activate Loop

Вам понадобится функция worksheetAdd, подобная этой

Private Sub WorksheetAdd(szJobNumber As String, Papersize As XlPaperSize, PageOrientation As XlPageOrientation) Dim bDisplayAlerts As Boolean On Error GoTo ErrorHandler 'Add worksheet to workbook. Set ws = ea.Worksheets.Add ws.Name = szJobNumber With ws.PageSetup .Orientation = PageOrientation .LeftFooter = "&D" .CenterFooter = "&A" .RightFooter = "Page &P of &N" .Papersize = Papersize End With On Error GoTo 0 Exit Sub ErrorHandler: If Err.Number = 1004 Then If MsgBox("There has been an error(#1004). Contact support. Excel is not installed or produced an error. Also, check for default printer.",vbCritical, "Information") = vbOK Then 'Unload frmPTReports Exit Sub End If Else Err.Raise Err.Number, Err.Source, Err.Description End If End Sub

qaru.site

создание новых листов из общего значения столбца MS Excel онлайн

В качестве обязанности работы мне было предложено открыть электронную таблицу в Excel 2003 (вскоре получить новый компьютер …) и разделить один лист на документ со многими листами, основанными на одном ID: Идентификатор поставщика #.

Рабочий лист имеет заголовок с одной строкой. Первая колонка заголовка – «VendorID». Теперь для каждого столбца есть ДОЗИНЫ других заголовков, и они содержат уравнения . Я хочу, чтобы листы были именем идентификатора поставщика.

Я хочу получить много листов:

Лист, называемый «00708», заголовок столбца «vendorId», который содержит:

vendid | B | C | D | 00708 | true | 1.07 | 4.52 |

Просто пример. Есть много столбцов различной информации. Многие.

Моя проблема в том, что на работе я пробовал этот код:

Option Explicit Sub DistributeRows() Dim wsAll As Worksheet Dim wsCrit As Worksheet Dim wsNew As Worksheet Dim LastRow As Long Dim LastRowCrit As Long Dim I As Long Set wsAll = Worksheets("Sheet1") ' change All to the name of the worksheet the existing data is on LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row Set wsCrit = Worksheets.Add ' column A has the criteria eg project ref wsAll.Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row For I = 2 To LastRowCrit Set wsNew = Worksheets.Add wsNew.Name = wsCrit.Range("A2") wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _ CopyToRange:=wsNew.Range("A1"), Unique:=False wsCrit.Rows(2).Delete Next I Application.DisplayAlerts = False wsCrit.Delete Application.DisplayAlerts = True End Sub

Проблема в том, что этот код работал КРАСИВОТО … до тех пор, пока я не прокрутил больше вправо и не понял, что многие из столбцов, хотя и были надлежащим образом перемещены, содержали пробелы, в которых были использованы не только числа, но и числа, которые учитываются хотя уравнения Excel (добавление значений из соседних с ними ячеек, что-то вроде этого)

Так что в основном …. нет окончательного кода для этого? Я обыскал в Интернете часами, но любой код, который я пытался, дал бы мне ошибки, которые я сожалею, что не помнил, чтобы я мог сказать вам. Я уверен, что код выше был тем, который работал, но он излучал важную информацию и уравнения и делал их пустыми.

У меня ~ 8000 строк и знаю, что excel может делать что-то вроде 65 000 строк. Я видел какой-то код, который пытается захватить угловые области, но мне это не нужно. Мне нужен код, который захватывает каждый столбец и каждую строку … смотрит на первое значение первого «типа» информации (в данном случае, идентификатор поставщика), а затем создает столько новых листов (в этом же документе), как и он должен создать один для каждого отдельного идентификатора поставщика.

Любая помощь приветствуется. Я стараюсь не делать это вручную, насколько это возможно.

Solutions Collecting From Web of "Excel VBA: создание новых листов из общего значения столбца"

excel.bilee.com

vba - Excel VBA: создание новых листов из общего значения столбца

В качестве обязанности работы мне было предложено открыть электронную таблицу в Excel 2003 (вскоре получить новый компьютер...) и разделить один лист на документ со многими листами, основанными на одном ID: Идентификатор поставщика #.

Рабочий лист имеет заголовок с одной строкой. Первая колонка заголовка - "VendorID". Теперь для каждого столбца есть ДОЗИНЫ других заголовков, и они содержат уравнения. Я хочу, чтобы листы были именем идентификатора поставщика.

Я хочу получить много листов:

Лист, называемый "00708", заголовок столбца "vendorId", который содержит:

vendid | B | C | D | 00708 | true | 1.07 | 4.52 |

Просто пример. Есть много столбцов различной информации. Многие.

Моя проблема в том, что на работе я пробовал этот код:

Проблема в том, что этот код работал КРАСИВОТО... до тех пор, пока я не прокрутил больше вправо и не понял, что многие из столбцов, хотя и были надлежащим образом перемещены, содержали пробелы, в которых были использованы не только числа, но и числа, которые учитываются хотя уравнения Excel (добавление значений из соседних с ними ячеек, что-то вроде этого)

Так что в основном.... нет окончательного кода для этого? Я обыскал в Интернете часами, но любой код, который я пытался, дал бы мне ошибки, которые я сожалею, что не помнил, чтобы я мог сказать вам. Я уверен, что код выше был тем, который работал, но он излучал важную информацию и уравнения и делал их пустыми.

У меня ~ 8000 строк и знаю, что excel может делать что-то вроде 65 000 строк. Я видел какой-то код, который пытается захватить угловые области, но мне это не нужно. Мне нужен код, который захватывает каждый столбец и каждую строку... смотрит на первое значение первого "типа" информации (в данном случае, идентификатор поставщика), а затем создает столько новых листов (в этом же документе), как и он должен создать один для каждого отдельного идентификатора поставщика.

Любая помощь приветствуется. Я стараюсь не делать это вручную, насколько это возможно.

qaru.site

vba - Сценарий Excel VBA для создания нового листа и редактирования формул соответственно

Это может показаться тривиальным, но я не могу получить никаких намеков на то, что мне нужно сделать в течение нескольких недель.

У меня есть сценарий, который создает шаблон для меня. Это ежедневный отчет, поэтому он создает одну и ту же таблицу для каждого дня месяца. Однако мне также нужно это, чтобы обновлять формулы в этом шаблоне.

У меня есть 2 документа. Позволяет называть их SOURCE И RESULTS. SOURCE имеет 28 листов на каждый день февраля. В A1 есть некоторые данные. У меня есть сценарий, который создает RESULTS также для каждого дня месяца на основе шаблона.

Однако каждый лист (каждый день) относится к тому же месту в SOURCE потому что он просто копирует таблицу с формулами. Таким образом, я получаю РЕЗУЛЬТАТЫ с 28 рабочими листами, где в каждый день формула относится к SOURCE 1.Feb.

Мне нужно, чтобы каждый рабочий лист ссылался на соответствующий день. Поэтому рабочий лист RESULTS для 1.Feb относится к SOURCE 1.Feb. РЕЗУЛЬТАТЫ 2.Feb относится к SOURCE 2.Feb.. и так далее.

Может ли кто-нибудь помочь?

здесь код

Private Sub Workbook_Open() Dim odpoved As Integer odpoved = MsgBox("Tento program ti pripravi prazdnu predlohu na XXX." & Chr(13) & "Pre pokracovanie stlac OK, pre ukoncenie programu alebo editaciu" & Chr(13) & "predlohy stlac Cancel!", vbOKCancel, "Welcome!") Select Case odpoved Case vbOK If odpoved = vbOK Then Call test End If Case vbCancel If odpoved = vbCancel Then MsgBox ("Proces ukonceny uzivatelom") GoTo Line2 End If End Select Line2: End Sub Sub test() ' ' Open and work Macro ' Dim selected_month As Long Dim day_count As Integer Dim day_loop As Integer Dim najdi_cestu As String najdi_cestu = ThisWorkbook.Path & "\" Application.ScreenUpdating = True 'Input Box to get the month number user wants to work with Line1: selected_month = 13 While (selected_month < 1) Or (selected_month > 12) selected_month = Val(InputBox("Zadaj poradove cislo mesiaca")) If selected_month = 0 Then Exit Sub Wend 'Script above will loop until 0 or 1 - 12 are inserted ' 'Select Case tells how many days there are in the selected month Select Case selected_month Case 4, 6, 9, 11 day_count = 30 Case 1, 3, 5, 7, 8, 10, 12 day_count = 31 Case Else day_count = 28 End Select ' For day_loop = day_count To 1 Step -1 Sheets("Template").Copy Before:=Sheets(2) ActiveSheet.Name = day_loop & "." & Left(MonthName(selected_month), 3) Next day_loop Application.DisplayAlerts = False Sheets("Template").Delete ' Auto pathfinder ActiveWorkbook.SaveAs Filename:=najdi_cestu & "Zmenový priebeh výroby " & Format(MonthName(selected_month)) & ".xlsx", FileFormat:= _ xlOpenXMLWorkbook MsgBox ("Tvoja predloha na mesiac " & Format(MonthName(selected_month)) & " bola ulozena do: " & najdi_cestu) ' manualny save 'ActiveWorkbook.SaveAs Filename:="C:\Users\pz595v\Desktop\Finalna verzia\" & Format(MonthName(selected_month)) & ".xlsx", FileFormat:= _ ' xlOpenXMLWorkbook Line3: End Sub

qaru.site

vba - excel vba - Создать новые листы на основе номера в столбце

У меня есть куча данных на одном листе, который сортируется по номеру отдела. Номера отделов четыре цифры и хранятся в столбце AI (vcol = 35)

Каждая строка данных связана с номером отдела. Мне нужно выполнить итерацию по документу, и для каждого номера отдела создайте новый лист в книге, названной с номером отдела, который имеет все данные, соответствующие этому номеру отдела. Я сделал кучу поиска и нашел пример в StackOverflow с того момента, когда я пытался изменить то, что мне нужно. Вот как выглядит мой макрос:

Sub parse_data() Dim lr As Long Dim ws As Worksheet Dim vcol, i As Integer Dim icol As Long Dim myarr As Variant Dim title As String Dim titlerow As Integer vcol = 35 Set ws = Sheets("Summary") lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row title = "A1:Ah2" titlerow = ws.Range(title).Cells(1).Row icol = ws.Columns.Count ws.Cells(1, icol) = "Unique" For i = 2 To lr On Error Resume Next If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol) End If Next myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants)) ws.Columns(icol).Clear For i = 2 To UBound(myarr) ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & "" If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = myarr(i) & "" Else Sheets(myarr(i) & "").Move After:=Worksheets(Worksheets.Count) End If ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1") Sheets(myarr(i) & "").Columns.AutoFit Next ws.AutoFilterMode = False ws.Activate End Sub

Но когда я запускаю это, все происходит. Первая проблема заключается в том, что она копирует ВСЕ данные из первого листа во все остальные листы (а не только данные, связанные с этим номером дельта), а вторая ошибка, возможно, связана с этим - это дает ошибку, говоря, что мой компьютер не работает, t достаточно памяти для выполнения операции. Может ли кто-нибудь взглянуть на это и посмотреть, где я могу ошибиться? Спасибо!

задан Alan 10 марта '17 в 20:53 источник поделиться

qaru.site