Excel VBA - копировать формулу и создавать новые листы - PullRequest
Новая
       36

Excel VBA - копировать формулу и создавать новые листы

0 голосов
/ 02 сентября 2011

если у меня есть лист с именем 'values', содержащий только 1 столбец с ячейками, например: 

ColumnA
---------
emp_id
emp_name
dept_id

, а затем второй лист с именем 'sql', содержащий 2 столбца с ячейками, например: 

ColumnA
--------
="select count(*) from tablex where "&a1&" is null;"
="select count(*) from tablex where length("&a1&") > 10;"

ColumnB
--------
Sheet for null
Sheet for length

Какой код макроса VBA (обратите внимание, он мне нужен в vba, поскольку я просто хочу нажать одну кнопку для генерации листов), мне нужно будет генерировать следующие два выходных листа (каждый лист только с одним столбцом): 

    Sheet for null
-------------------
select count(*) from tablex where emp_id is null;
select count(*) from tablex where emp_name is null;
select count(*) from tablex where dept_id is null;


    Sheet for length
-------------------
select count(*) from tablex where length(emp_id) > 10;
select count(*) from tablex where length(emp_name) > 10;
select count(*) from tablex where length(dept_id) > 10;

1 Ответ

1 голос
/ 02 сентября 2011

Я думаю, что это будет делать то, что вы просите.

Одно изменение, которое я сделал, заключается в том, что на листе "sql" я изменил содержимое ячейки, чтобы оно выглядело так: 

="select count(*) from tablex where variable is null;"

поэтому я использовал " переменная " вместо " & a1 & ", как вы это делали изначально, а затем в коде заменяет это слово на правильное значение emp_id, emp_name и т. д. 

    Sub GenerateSheets()
    Dim formulaRange As Range
    Dim formula As String
    Dim r As Range
    Dim destloc As Range
    Dim VariableRange As Range

    Set formulaRange = Worksheets("sql").Cells(1, 1)
    ' get each formula
    Do Until formulaRange.Value = ""
        For Each r In formulaRange.Rows
            ' for each formula found, create a new sheet and move it to end
            Worksheets.Add
            ActiveSheet.Name = r.Offset(0, 1).Value
            ActiveSheet.Move after:=Sheets(ActiveWorkbook.Sheets.Count)

            Set destloc = ActiveSheet.Cells(1, 1)
            Set VariableRange = Worksheets("values").Cells(1.1)
            ' Loop through all the variables
            Do Until VariableRange.Value = ""
                destloc.Value = Replace(formulaRange.Value, "variable", VariableRange.Value)

                Set VariableRange = VariableRange.Offset(1, 0)
                Set destloc = destloc.Offset(1, 0)
            Loop
        Next

        Set formulaRange = formulaRange.Offset(1, 0)
    Loop 
End Sub
...