Объедините несколько Сабов в один суб VBA
Я довольно новичок в VBA, этом форуме и программировании в целом. У меня есть рабочий лист, и мне удалось погуглить и настроить некоторые строки кода в соответствии с моими требованиями.
Моя проблема заключается в том, что у меня есть три Сабы в общей сложности и я должен запускать каждый сценарий VBA шаг за шагом. Я хочу объединить все три сценария VBA в один. (Шаг 1 + Шаг 2 + Шаг 3 = Все в одном Sub)
Не могли бы вы сказать мне, как я могу объединить тезисы нескольких скриптов VBA или Sub под umbrealla одного sub so что мне просто нужно запустить сценарий VBA один раз вместо трех.
'---------Step1----------------------------------------
'----Run the macro press F5-----
'========================================================================
' DELETES ALL ROWS FROM F DOWNWARDS WITH THE WORDs " " IN COLUMN F
'========================================================================
Sub DeleteRowWithContents()
Last = Cells(Rows.Count, "F").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "F").Value) = "Ja" Or (Cells(i, "F").Value) = "Unbearbeitet" Or (Cells(i, "F").Value) = "-" Or (Cells(i, "F").Value) = "" Then
'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW
Cells(i, "A").EntireRow.Delete
End If
Next i
End Sub
'-------------------------------Step 2--------------------
'---Run the macro, press F5. The macro compares the row contents in column A and if found a match deletes one of the results--
Sub btest()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
If Range("A" & i).Value = Range("A" & i - 1).Value Then Rows(i).Delete
Next i
End Sub
'-----------------Step 3---------
'--------Delete Unwanted Columns and adjust the column width----
Sub sbVBS_To_Delete_EntireColumn_For_Loop()
Dim iCntr
Dim kCntr
Dim jCntr
For iCntr = 1 To 4 Step 1
Columns(2).EntireColumn.Delete '-----Del unwanted columns----
Next
For kCntr = 1 To 3 Step 1
Columns(3).EntireColumn.Delete
Next
For jCntr = 1 To 8 Step 1
Columns(4).EntireColumn.Delete
Next
ActiveSheet.Columns("A").Columnwidth = 20 '----Adjust Column width---
ActiveSheet.Columns("C").Columnwidth = 25
ActiveSheet.Columns("E").Columnwidth = 25
End Sub
2 ответа:
Sub Main() DeleteRowWithContents btest sbVBS_To_Delete_EntireColumn_For_Loop End Sub
Должен делать.
При желании вы можете добавить к другим подменю модификатор
Private
, чтобы они не появлялись в окне макросов (ALT+F8 в представлении электронной таблицы), и у вас есть толькоMain
, перечисленные там.В качестве альтернативы, вы могли бы иметь другие 3 шага-Sub взять фиктивные необязательные параметры, чтобы скрыть их от диалогового окна макроса.
@vba4all-большое спасибо. Это действует как заклинание. Как мне поставить этот вопрос на решенный?
@futureresearchers-вот как выглядит код..
Sub Main() '======================================================================== ' DELETES ALL ROWS FROM F DOWNWARDS WITH THE WORDs " " IN COLUMN F '======================================================================== Last = Cells(Rows.Count, "F").End(xlUp).Row For i = Last To 1 Step -1 If (Cells(i, "F").Value) = "Ja" Or (Cells(i, "F").Value) = "Unbearbeitet" Or (Cells(i, "F").Value) = "-" Or (Cells(i, "F").Value) = "" Then 'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW Cells(i, "A").EntireRow.Delete End If Next i '---Run the macro, press F5. The macro compares the row contents in column A and if found a match deletes one of the results and the complete row-- Dim LR As Long, x As Long LR = Range("A" & Rows.Count).End(xlUp).Row For x = LR To 2 Step -1 If Range("A" & x).Value = Range("A" & x - 1).Value Then Rows(x).Delete Next x '--------Delete Unwanted Columns and adjust the column width---- Dim lCntr Dim kCntr Dim jCntr For lCntr = 1 To 4 Step 1 Columns(2).EntireColumn.Delete '-----Del unwanted columns here the col b,c,d, e is to be deleted---- Next For kCntr = 1 To 3 Step 1 Columns(3).EntireColumn.Delete '--enable or disable this loc if you dont wish to further delete cols--- Next For jCntr = 1 To 8 Step 1 Columns(4).EntireColumn.Delete '--enable or disable this loc if you dont wish to further delete cols--- Next ActiveSheet.Columns("A").ColumnWidth = 20 '----Adjust Column width--- ActiveSheet.Columns("C").ColumnWidth = 25 ActiveSheet.Columns("E").ColumnWidth = 25 End Sub