将多个 Sub 合并为一个 VBA Sub

Combine Multiple Subs into One VBA Sub

提问by wildradical

I am pretty new to VBA, this forum and programming in general. I have a worksheet and i have managed to google and tweak certain code lines as per my requirement.

我对 VBA、这个论坛和一般编程都很陌生。我有一个工作表，我设法按照我的要求在谷歌上搜索并调整了某些代码行。

My issue is i have three subs in total and have to run every VBA script Step by Step. I wish to combine all the three VBA scripts into one. (Step 1 + Step 2 + Step 3 = All in one Sub)

我的问题是我总共有三个子程序，并且必须逐步运行每个 VBA 脚本。我希望将所有三个 VBA 脚本合二为一。（步骤 1 + 步骤 2 + 步骤 3 = 全合一）

Can you please tell me how i can combine theses multiple VBA scripts or Subs under an umbrealla of one single sub so that i just have to run the VBA script once instead of thrice.

你能告诉我如何将这些多个 VBA 脚本或 Subs 组合在一个单独的 subrealla 下，这样我只需要运行一次 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

采纳答案by wildradical

Sub Main()

    DeleteRowWithContents
    btest
    sbVBS_To_Delete_EntireColumn_For_Loop

End Sub

should do.

应该做。

Optionally you could prefix your other subs with a Privatemodifier so they don't appear in the macros window (ALT+F8in spreadsheet view) and you only have the Mainlisted there.

或者，您可以使用Private修饰符为您的其他字幕添加前缀，这样它们就不会出现在宏窗口中（电子表格视图中的ALT+ F8），并且您只会在Main那里列出。

Alternatively, you could have the other 3 step-subs take dummy Optional Parameters to hide them from the Macro dialog box.

或者，您可以让其他 3 个 step-subs 使用虚拟可选参数将它们从“宏”对话框中隐藏。

回答by wildradical

@vba4all- Thank you very much. It works like a charm. How do i put this issue on Solved?

@vba4all-非常感谢。它就像一个魅力。我如何将这个问题放到 Solved 上？

@futureresearchers- thats how the code looks like..

@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