独立工作的代码片段，拼接在一起时不再工作 - VBA 用户表单
Code Snips that work independently, no longer work when stitched together - VBA Userform
我的任务是制作一个 vba 脚本，该脚本的用户窗体带有文本字段、浏览按钮和转换按钮。它需要两个不同的 .csv 文件，检查特定列是否存在，如果确实存在，则根据 header 名称执行一组格式化和列删除。如果不是，则根据 header 名称执行一组不同的格式设置。之后它会在默认打印机上打印出来。
我从许多不同的人才那里缝合了许多不同的解决方案，以及我自己的代码。一次测试一个时，每个人都可以完美地工作。一旦我将它们放在一起，我就遇到了障碍。
我收到错误
"Compile error: Else without If"
我搜索并发现许多线程，其中人们说如果您在同一行的 then 之后添加任何语句，它会关闭 if 语句。我检查了我的代码，但找不到它的任何实例。
几天来我一直盯着同一块代码，但离解决方案还差得很远。我希望有新的愿意的眼睛能发现我犯错的地方。
欢迎提出任何建议！
先谢谢大家。
'Shows Open File Dialog Box.
Private Sub CommandButton1_Click()
' Private Sub openDialog()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = FALSE
' Set the title of the dialog box.
.title = "Please Select the file."
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Report Export", "*.csv"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = TRUE Then
TextBox1 = .SelectedItems(1)
End If
End With
' End Sub
End Sub
'****************************************
Private Sub Convert_Click()
If TextBox1.Value = "" Then
MsgBox "Please Select a file first!"
Else
Workbooks.Open Filename:=TextBox1ActiveSheet.Name = "REPORT"
'DELETES BLANK ROWS
Dim iCounter As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = FALSE
For iCounter = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(iCounter)) = 0 Then
Selection.Rows(iCounter).EntireRow.Delete
End If
Next iCounter
.Calculation = xlCalculationAutomatic
.ScreenUpdating = TRUE
End With
'************************
Dim rngToSearch As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Set rngToSearch = ThisWorkbook.Worksheets("REPORT").Range("A1:Z1")
WhatToFind = Array("Card Type") 'add all Column header that you want to check
With rngToSearch
For iCtr = LBound(WhatToFind) To UBound(WhatToFind)
If WorksheetFunction.CountIf(rngToSearch, WhatToFind(iCtr)) > 0 Then ' Check if column is preset or not
' CODE if column exists
'********START CC********
'DELETES UNUSED COLUMNS
Dim currentColumn As Integer
Dim columnHeading As String
ActiveSheet.Columns("Z").Delete
For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value
'CHECK WHETHER TO KEEP THE COLUMN
Select Case columnHeading
Case "User", "Effective Date", "Account", "Customer Name", "Email", "Auth Amount", "Auth Status", "Auth Code"
'Do nothing
Case Else
'Delete if the cell doesn't contain "Homer"
If InStr(1, _
ActiveSheet.UsedRange.Cells(1, currentColumn).Value, _
"Homer", vbBinaryCompare) = 0 Then
ActiveSheet.Columns(currentColumn).Delete
End If
End Select
Next
'Format Sheets
'****Column User****
Dim colUser As Long
Dim ColumnUser As Long
'Get Column User
colUser = WorksheetFunction.Match("User", Rows("1:1"), 0)
'Convert To Column Letter
ColumnUser = Split(Cells(1, colUser).Address, "$")(1)
'****Column EffectiveDate****
Dim colEffectiveDate As Long
Dim ColumnEffectiveDate As Long
'Get Column EffectiveDate
colEffectiveDate = WorksheetFunction.Match("Effective Date", Rows("1:1"), 0)
'Convert To Column Letter
ColumnEffectiveDate = Split(Cells(1, colEffectiveDate).Address, "$")(1)
'****Column Account****
Dim colAccount As Long
Dim ColumnAccount As Long
'Get Column Account
colAccount = WorksheetFunction.Match("Account", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAccount = Split(Cells(1, colAccount).Address, "$")(1)
'****Column CustName****
Dim colCustName As Long
Dim ColumnCustName As Long
'Get Column Account
colCustName = WorksheetFunction.Match("Customer Name", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustName = Split(Cells(1, colCustName).Address, "$")(1)
'****Column CustEmail****
Dim colCustEmail As Long
Dim ColumnCustEmail As Long
'Get Column Account
colCustEmail = WorksheetFunction.Match("Email", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustEmail = Split(Cells(1, colCustEmail).Address, "$")(1)
'****Column Amount****
Dim colAmount As Long
Dim ColumnAmount As Long
'Get Column Account
colAmount = WorksheetFunction.Match("Auth Amount", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAmount = Split(Cells(1, colAmount).Address, "$")(1)
'****Column AuthStatus****
Dim colAuthStatus As Long
Dim ColumnAuthStatus As Long
'Get Column Account
colAuthStatus = WorksheetFunction.Match("Auth Status", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAuthStatus = Split(Cells(1, colAuthStatus).Address, "$")(1)
'****Column AuthCode****
Dim colAuthCode As Long
Dim ColumnAuthCode As Long
'Get Column Account
colAuthCode = WorksheetFunction.Match("Auth Code", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAuthCode = Split(Cells(1, colAuthCode).Address, "$")(1)
' Sets Column Widths
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).EntireColumn.AutoFit
Worksheets("REPORT").Range(ColumnCustName & ":" & ColumnCustEmail).ColumnWidth = 30
' Turns Word Wrap ON
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).WrapText = TRUE
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).VerticalAlignment = xlVAlignTop
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).HorizontalAlignment = xlHAlignLeft
Worksheets("REPORT").Range("A1").EntireRow.Font.Bold = TRUE
Worksheets("REPORT").Range("A1").EntireRow.Font.Size = 12
' Set Page Settings
ActiveSheet.Range(ColumnUser & ":" & ColumnAuthCode).CurrentRegion
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = FALSE
.FitToPagesWide = 1
.FitToPagesTall = FALSE
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
End With
'Finds the last non-blank cell in a single row or column
Dim lRow As Long
'Find the last non-blank cell
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' Row color change
Dim i As Integer
For i = 2 To lRow
If i Mod 2 = 0 Then
ActiveSheet.Range(ActiveSheet.Cells(i, 1), ActiveSheet.Cells(i, lCol)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
Next i
' Add Totals
Dim LastRow As Long
Dim bottomRow As Long
LastRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
If LastRow >= 2 Then
Cells(LastRow + 2, ColumnAmount).Formula = "=SUM(" & ColumnAmount & "2" & ":" & ColumnAmount & LastRow & ")"
ElseIf LastRow < 2 Then
Cells(LastRow + 2, ColumnAmount).Value = Range(ColumnAmount & "2").Value
End If
Cells(lRow + 2, ColumnCustEmail).Value = "Total:"
bottomRow = lRow + 2
Let Copyrange = ColumnCustEmail & bottomRow & ":" & ColumnAmount & bottomRow
Range(Copyrange).BorderAround _
ColorIndex:=3, Weight:=xlThick
Range(Copyrange).Font.Bold = TRUE
Range(Copyrange).Font.Size = 14
' Add Auto Print HERE
Worksheets("REPORT").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.DisplayAlerts = FALSE
Application.Quit
End If
End Sub
'*********End of CCs**********
Else
' CODE if column is Not Found
'********CHECKS********
'DELETES UNUSED COLUMNS
Dim currentColumn As Integer
Dim columnHeading As String
ActiveSheet.Columns("Z").Delete
For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value
'CHECK WHETHER TO KEEP THE COLUMN
Select Case columnHeading
Case "User", "Payment Date", "Account", "Customer Name", "Customer Email", "Amount", "Comment"
'Do nothing
Case Else
'Delete if the cell doesn't contain "Homer"
If InStr(1, _
ActiveSheet.UsedRange.Cells(1, currentColumn).Value, _
"Homer", vbBinaryCompare) = 0 Then
ActiveSheet.Columns(currentColumn).Delete
End If
End Select
Next
'Format Sheets
'****Column User****
Dim colUser As Long
Dim ColumnUser As Long
'Get Column User
colUser = WorksheetFunction.Match("User", Rows("1:1"), 0)
'Convert To Column Letter
ColumnUser = Split(Cells(1, colUser).Address, "$")(1)
'****Column PaymentDate****
Dim colPaymentDate As Long
Dim ColumnPaymentDate As Long
'Get Column PaymentDate
colPaymentDate = WorksheetFunction.Match("Payment Date", Rows("1:1"), 0)
'Convert To Column Letter
ColumnPaymentDate = Split(Cells(1, colPaymentDate).Address, "$")(1)
'****Column Account****
Dim colAccount As Long
Dim ColumnAccount As Long
'Get Column Account
colAccount = WorksheetFunction.Match("Account", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAccount = Split(Cells(1, colAccount).Address, "$")(1)
'****Column CustName****
Dim colCustName As Long
Dim ColumnCustName As Long
'Get Column Account
colCustName = WorksheetFunction.Match("Customer Name", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustName = Split(Cells(1, colCustName).Address, "$")(1)
'****Column CustEmail****
Dim colCustEmail As Long
Dim ColumnCustEmail As Long
'Get Column Account
colCustEmail = WorksheetFunction.Match("Customer Email", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustEmail = Split(Cells(1, colCustEmail).Address, "$")(1)
'****Column Amount****
Dim colAmount As Long
Dim ColumnAmount As Long
'Get Column Account
colAmount = WorksheetFunction.Match("Amount", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAmount = Split(Cells(1, colAmount).Address, "$")(1)
'****Column Comment****
Dim colComment As Long
Dim ColumnComment As Long
'Get Column Account
colComment = WorksheetFunction.Match("Comment", Rows("1:1"), 0)
'Convert To Column Letter
ColumnComment = Split(Cells(1, colComment).Address, "$")(1)
' Sets Column Widths
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).EntireColumn.AutoFit
Worksheets("REPORT").Range(ColumnCustName & ":" & ColumnCustEmail).ColumnWidth = 30
Worksheets("REPORT").Range(ColumnComment & ":" & ColumnComment).ColumnWidth = 50
' Turns Word Wrap ON
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).WrapText = TRUE
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).VerticalAlignment = xlVAlignTop
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).HorizontalAlignment = xlHAlignLeft
Worksheets("REPORT").Range("A1").EntireRow.Font.Bold = TRUE
Worksheets("REPORT").Range("A1").EntireRow.Font.Size = 12
' Set Page Settings
ActiveSheet.Range(ColumnUser & ":" & ColumnComment).CurrentRegion
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = FALSE
.FitToPagesWide = 1
.FitToPagesTall = FALSE
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
End With
'Finds the last non-blank cell in a single row or column
Dim lRow As Long
'Find the last non-blank cell
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' Row color change
Dim i As Integer
For i = 2 To lRow
If i Mod 2 = 0 Then
ActiveSheet.Range(ActiveSheet.Cells(i, 1), ActiveSheet.Cells(i, lCol)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
Next i
' Add Totals
Dim LastRow As Long
Dim bottomRow As Long
LastRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
If LastRow >= 2 Then
Cells(LastRow + 2, ColumnAmount).Formula = "=SUM(" & ColumnAmount & "2" & ":" & ColumnAmount & LastRow & ")"
ElseIf LastRow < 2 Then
Cells(LastRow + 2, ColumnAmount).Value = Range(ColumnAmount & "2").Value
End If
Cells(lRow + 2, ColumnCustEmail).Value = "Total:"
bottomRow = lRow + 2
Let Copyrange = ColumnCustEmail & bottomRow & ":" & ColumnAmount & bottomRow
Range(Copyrange).BorderAround _
ColorIndex:=3, Weight:=xlThick
Range(Copyrange).Font.Bold = TRUE
Range(Copyrange).Font.Size = 14
' Add Auto Print HERE
Worksheets("REPORT").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.DisplayAlerts = FALSE
Application.Quit
End If
End Sub
'********END CHECKS*********
End If
Next
End With
End Sub
编辑：
所做的更改：
- 折叠并压缩我的代码以删除不需要的空行。
- Tab 正确缩进了代码
- 删除了错误留在其中的结束标记。
- 在遗漏的地方添加了结束标签。
- 添加了变量定义
- 更正了 Object 个参考文献。
- 大量调试。
谢谢大家的帮助。我学到了一些更好的做法，并且能够搞定一切 运行!
问题出在这里：
'*********End of CCs**********
Else
' CODE if column is Not Found
'********CHECKS********
end sub 似乎不合适。要么做一个新的子，要么删除它。
正如评论者所说，使您的制表符对称将大有帮助。另外，写short functions。刚开始做的时候，感觉自己写的子程序太多了。但它使代码更容易理解。
我写了一个 "Main" 子程序，然后让它调用每个其他函数。大大减少了我的错误。
干杯！
首先，始终在代码顶部声明 Option Explicit。如果这样做，那么您将看到许多未声明的变量。此外，您会看到大量重复变量..
特别是关于您的错误消息，这是因为您有一个流氓 Else 并且您还有一个 2 x 流氓 End If 并且您缺少一个 End If.我已经在你的代码中评论了这些。将它们都删除，您的代码将 有效 .
此外，您在一个过程中多次使用了 End Sub。我会在这里假设你真正想要做的是 EXIT sub，从而代替 Exit Sub
我通常不会审查和重写代码，但您的代码很乱，缩进不正确，这无疑导致了您遇到的问题。整洁的代码易于阅读，易于编写。然而，我确实赞同上面的观点，即较小的过程是良好的代码编写技巧的关键。
'Shows Open File Dialog Box.
Private Sub CommandButton1_Click()
' Private Sub openDialog()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please Select the file."
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Report Export", "*.csv"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
TextBox1 = .SelectedItems(1)
End If
End With
End Sub
'****************************************
Private Sub Convert_Click()
If TextBox1.Value = "" Then
MsgBox "Please Select a file first!"
Else
Workbooks.Open Filename:=TextBox1ActiveSheet.Name = "REPORT"
'DELETES BLANK ROWS
Dim iCounter As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For iCounter = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(iCounter)) = 0 Then
Selection.Rows(iCounter).EntireRow.Delete
End If
Next iCounter
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
'************************
Dim rngToSearch As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Set rngToSearch = ThisWorkbook.Worksheets("REPORT").Range("A1:Z1")
WhatToFind = Array("Card Type") 'add all Column header that you want to check
With rngToSearch
For iCtr = LBound(WhatToFind) To UBound(WhatToFind)
If WorksheetFunction.CountIf(rngToSearch, WhatToFind(iCtr)) > 0 Then ' Check if column is preset or not
' CODE if column exists
'********START CC********
'DELETES UNUSED COLUMNS
Dim currentColumn As Integer
Dim columnHeading As String
ActiveSheet.Columns("Z").Delete
For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value
'CHECK WHETHER TO KEEP THE COLUMN
Select Case columnHeading
Case "User", "Effective Date", "Account", "Customer Name", "Email", "Auth Amount", "Auth Status", "Auth Code"
'Do nothing
Case Else
'Delete if the cell doesn't contain "Homer"
If InStr(1, ActiveSheet.UsedRange.Cells(1, currentColumn).Value, _
"Homer", vbBinaryCompare) = 0 Then
ActiveSheet.Columns(currentColumn).Delete
End If
End Select
Next
'Format Sheets
'****Column User****
Dim colUser As Long
Dim ColumnUser As Long
'Get Column User
colUser = WorksheetFunction.Match("User", Rows("1:1"), 0)
'Convert To Column Letter
ColumnUser = Split(Cells(1, colUser).Address, "$")(1)
'****Column EffectiveDate****
Dim colEffectiveDate As Long
Dim ColumnEffectiveDate As Long
'Get Column EffectiveDate
colEffectiveDate = WorksheetFunction.Match("Effective Date", Rows("1:1"), 0)
'Convert To Column Letter
ColumnEffectiveDate = Split(Cells(1, colEffectiveDate).Address, "$")(1)
'****Column Account****
Dim colAccount As Long
Dim ColumnAccount As Long
'Get Column Account
colAccount = WorksheetFunction.Match("Account", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAccount = Split(Cells(1, colAccount).Address, "$")(1)
'****Column CustName****
Dim colCustName As Long
Dim ColumnCustName As Long
'Get Column Account
colCustName = WorksheetFunction.Match("Customer Name", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustName = Split(Cells(1, colCustName).Address, "$")(1)
'****Column CustEmail****
Dim colCustEmail As Long
Dim ColumnCustEmail As Long
'Get Column Account
colCustEmail = WorksheetFunction.Match("Email", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustEmail = Split(Cells(1, colCustEmail).Address, "$")(1)
'****Column Amount****
Dim colAmount As Long
Dim ColumnAmount As Long
'Get Column Account
colAmount = WorksheetFunction.Match("Auth Amount", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAmount = Split(Cells(1, colAmount).Address, "$")(1)
'****Column AuthStatus****
Dim colAuthStatus As Long
Dim ColumnAuthStatus As Long
'Get Column Account
colAuthStatus = WorksheetFunction.Match("Auth Status", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAuthStatus = Split(Cells(1, colAuthStatus).Address, "$")(1)
'****Column AuthCode****
Dim colAuthCode As Long
Dim ColumnAuthCode As Long
'Get Column Account
colAuthCode = WorksheetFunction.Match("Auth Code", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAuthCode = Split(Cells(1, colAuthCode).Address, "$")(1)
' Sets Column Widths
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).EntireColumn.AutoFit
Worksheets("REPORT").Range(ColumnCustName & ":" & ColumnCustEmail).ColumnWidth = 30
' Turns Word Wrap ON
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).WrapText = True
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).VerticalAlignment = xlVAlignTop
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).HorizontalAlignment = xlHAlignLeft
Worksheets("REPORT").Range("A1").EntireRow.Font.Bold = True
Worksheets("REPORT").Range("A1").EntireRow.Font.Size = 12
' Set Page Settings
ActiveSheet.Range(ColumnUser & ":" & ColumnAuthCode).CurrentRegion
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
End With
'Finds the last non-blank cell in a single row or column
Dim lRow As Long
'Find the last non-blank cell
lRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' Row color change
Dim i As Integer
For i = 2 To lRow
If i Mod 2 = 0 Then
ActiveSheet.Range(ActiveSheet.Cells(i, 1), ActiveSheet.Cells(i, _
lCol)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
Next i
' Add Totals
Dim LastRow As Long
Dim bottomRow As Long
LastRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False).Row
If LastRow >= 2 Then
Cells(LastRow + 2, ColumnAmount).Formula = "=SUM(" & ColumnAmount & _
"2" & ":" & ColumnAmount & LastRow & ")"
ElseIf LastRow < 2 Then
Cells(LastRow + 2, ColumnAmount).Value = Range(ColumnAmount & _
"2").Value
End If
Cells(lRow + 2, ColumnCustEmail).Value = "Total:"
bottomRow = lRow + 2
Let Copyrange = ColumnCustEmail & bottomRow & ":" & ColumnAmount & bottomRow
Range(Copyrange).BorderAround ColorIndex:=3, Weight:=xlThick
Range(Copyrange).Font.Bold = True
Range(Copyrange).Font.Size = 14
' Add Auto Print HERE
Worksheets("REPORT").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.DisplayAlerts = False
Application.Quit
End If
Exit Sub
'*********End of CCs**********
'==========================================================='
' this is your problem
' Else
' delete this ^^
'==========================================================='
' CODE if column is Not Found
'********CHECKS********
'DELETES UNUSED COLUMNS
ActiveSheet.Columns("Z").Delete
For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value
'CHECK WHETHER TO KEEP THE COLUMN
Select Case columnHeading
Case "User", "Payment Date", "Account", "Customer Name", "Customer Email", "Amount", "Comment"
'Do nothing
Case Else
'Delete if the cell doesn't contain "Homer"
If InStr(1, ActiveSheet.UsedRange.Cells(1, currentColumn).Value, "Homer", _
vbBinaryCompare) = 0 Then
ActiveSheet.Columns(currentColumn).Delete
End If
End Select
Next
'Format Sheets
'****Column User****
'Get Column User
colUser = WorksheetFunction.Match("User", Rows("1:1"), 0)
'Convert To Column Letter
ColumnUser = Split(Cells(1, colUser).Address, "$")(1)
'****Column PaymentDate****
Dim colPaymentDate As Long
Dim ColumnPaymentDate As Long
'Get Column PaymentDate
colPaymentDate = WorksheetFunction.Match("Payment Date", Rows("1:1"), 0)
'Convert To Column Letter
ColumnPaymentDate = Split(Cells(1, colPaymentDate).Address, "$")(1)
'****Column Account****
'Get Column Account
colAccount = WorksheetFunction.Match("Account", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAccount = Split(Cells(1, colAccount).Address, "$")(1)
'****Column CustName****
'Get Column Account
colCustName = WorksheetFunction.Match("Customer Name", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustName = Split(Cells(1, colCustName).Address, "$")(1)
'****Column CustEmail****
'Get Column Account
colCustEmail = WorksheetFunction.Match("Customer Email", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustEmail = Split(Cells(1, colCustEmail).Address, "$")(1)
'****Column Amount****
'Get Column Account
colAmount = WorksheetFunction.Match("Amount", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAmount = Split(Cells(1, colAmount).Address, "$")(1)
'****Column Comment****
Dim colComment As Long
Dim ColumnComment As Long
'Get Column Account
colComment = WorksheetFunction.Match("Comment", Rows("1:1"), 0)
'Convert To Column Letter
ColumnComment = Split(Cells(1, colComment).Address, "$")(1)
' Sets Column Widths
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).EntireColumn.AutoFit
Worksheets("REPORT").Range(ColumnCustName & ":" & ColumnCustEmail).ColumnWidth = 30
Worksheets("REPORT").Range(ColumnComment & ":" & ColumnComment).ColumnWidth = 50
' Turns Word Wrap ON
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).WrapText = True
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).VerticalAlignment = xlVAlignTop
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).HorizontalAlignment = xlHAlignLeft
Worksheets("REPORT").Range("A1").EntireRow.Font.Bold = True
Worksheets("REPORT").Range("A1").EntireRow.Font.Size = 12
' Set Page Settings
ActiveSheet.Range(ColumnUser & ":" & ColumnComment).CurrentRegion
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
End With
'Finds the last non-blank cell in a single row or column
'Find the last non-blank cell
lRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' Row color change
For i = 2 To lRow
If i Mod 2 = 0 Then
ActiveSheet.Range(ActiveSheet.Cells(i, 1), ActiveSheet.Cells(i, lCol)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
Next i
' Add Totals
LastRow = Cells.Find(What:="*", After:=Range("A1"), _
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
If LastRow >= 2 Then
Cells(LastRow + 2, ColumnAmount).Formula = "=SUM(" & ColumnAmount & "2" & ":" & ColumnAmount & LastRow & ")"
ElseIf LastRow < 2 Then
Cells(LastRow + 2, ColumnAmount).Value = Range(ColumnAmount & "2").Value
End If
Cells(lRow + 2, ColumnCustEmail).Value = "Total:"
bottomRow = lRow + 2
Let Copyrange = ColumnCustEmail & bottomRow & ":" & ColumnAmount & bottomRow
Range(Copyrange).BorderAround _
ColorIndex:=3, Weight:=xlThick
Range(Copyrange).Font.Bold = True
Range(Copyrange).Font.Size = 14
' Add Auto Print HERE
Worksheets("REPORT").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.DisplayAlerts = False
Application.Quit
'==========================================================='
' this is your problem
' End If
' delete this ^^
'==========================================================='
Exit Sub
'********END CHECKS*********
'==========================================================='
' this is your problem
' End If
' delete this ^^
'==========================================================='
Next iCtr
End With
'==========================================================='
' this is your problem
End If
' added this ^^
'==========================================================='
End Sub
我的任务是制作一个 vba 脚本，该脚本的用户窗体带有文本字段、浏览按钮和转换按钮。它需要两个不同的 .csv 文件，检查特定列是否存在，如果确实存在，则根据 header 名称执行一组格式化和列删除。如果不是，则根据 header 名称执行一组不同的格式设置。之后它会在默认打印机上打印出来。
我从许多不同的人才那里缝合了许多不同的解决方案，以及我自己的代码。一次测试一个时，每个人都可以完美地工作。一旦我将它们放在一起，我就遇到了障碍。
我收到错误
"Compile error: Else without If"
我搜索并发现许多线程，其中人们说如果您在同一行的 then 之后添加任何语句，它会关闭 if 语句。我检查了我的代码，但找不到它的任何实例。
几天来我一直盯着同一块代码，但离解决方案还差得很远。我希望有新的愿意的眼睛能发现我犯错的地方。
欢迎提出任何建议！
先谢谢大家。
'Shows Open File Dialog Box.
Private Sub CommandButton1_Click()
' Private Sub openDialog()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = FALSE
' Set the title of the dialog box.
.title = "Please Select the file."
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Report Export", "*.csv"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = TRUE Then
TextBox1 = .SelectedItems(1)
End If
End With
' End Sub
End Sub
'****************************************
Private Sub Convert_Click()
If TextBox1.Value = "" Then
MsgBox "Please Select a file first!"
Else
Workbooks.Open Filename:=TextBox1ActiveSheet.Name = "REPORT"
'DELETES BLANK ROWS
Dim iCounter As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = FALSE
For iCounter = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(iCounter)) = 0 Then
Selection.Rows(iCounter).EntireRow.Delete
End If
Next iCounter
.Calculation = xlCalculationAutomatic
.ScreenUpdating = TRUE
End With
'************************
Dim rngToSearch As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Set rngToSearch = ThisWorkbook.Worksheets("REPORT").Range("A1:Z1")
WhatToFind = Array("Card Type") 'add all Column header that you want to check
With rngToSearch
For iCtr = LBound(WhatToFind) To UBound(WhatToFind)
If WorksheetFunction.CountIf(rngToSearch, WhatToFind(iCtr)) > 0 Then ' Check if column is preset or not
' CODE if column exists
'********START CC********
'DELETES UNUSED COLUMNS
Dim currentColumn As Integer
Dim columnHeading As String
ActiveSheet.Columns("Z").Delete
For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value
'CHECK WHETHER TO KEEP THE COLUMN
Select Case columnHeading
Case "User", "Effective Date", "Account", "Customer Name", "Email", "Auth Amount", "Auth Status", "Auth Code"
'Do nothing
Case Else
'Delete if the cell doesn't contain "Homer"
If InStr(1, _
ActiveSheet.UsedRange.Cells(1, currentColumn).Value, _
"Homer", vbBinaryCompare) = 0 Then
ActiveSheet.Columns(currentColumn).Delete
End If
End Select
Next
'Format Sheets
'****Column User****
Dim colUser As Long
Dim ColumnUser As Long
'Get Column User
colUser = WorksheetFunction.Match("User", Rows("1:1"), 0)
'Convert To Column Letter
ColumnUser = Split(Cells(1, colUser).Address, "$")(1)
'****Column EffectiveDate****
Dim colEffectiveDate As Long
Dim ColumnEffectiveDate As Long
'Get Column EffectiveDate
colEffectiveDate = WorksheetFunction.Match("Effective Date", Rows("1:1"), 0)
'Convert To Column Letter
ColumnEffectiveDate = Split(Cells(1, colEffectiveDate).Address, "$")(1)
'****Column Account****
Dim colAccount As Long
Dim ColumnAccount As Long
'Get Column Account
colAccount = WorksheetFunction.Match("Account", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAccount = Split(Cells(1, colAccount).Address, "$")(1)
'****Column CustName****
Dim colCustName As Long
Dim ColumnCustName As Long
'Get Column Account
colCustName = WorksheetFunction.Match("Customer Name", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustName = Split(Cells(1, colCustName).Address, "$")(1)
'****Column CustEmail****
Dim colCustEmail As Long
Dim ColumnCustEmail As Long
'Get Column Account
colCustEmail = WorksheetFunction.Match("Email", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustEmail = Split(Cells(1, colCustEmail).Address, "$")(1)
'****Column Amount****
Dim colAmount As Long
Dim ColumnAmount As Long
'Get Column Account
colAmount = WorksheetFunction.Match("Auth Amount", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAmount = Split(Cells(1, colAmount).Address, "$")(1)
'****Column AuthStatus****
Dim colAuthStatus As Long
Dim ColumnAuthStatus As Long
'Get Column Account
colAuthStatus = WorksheetFunction.Match("Auth Status", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAuthStatus = Split(Cells(1, colAuthStatus).Address, "$")(1)
'****Column AuthCode****
Dim colAuthCode As Long
Dim ColumnAuthCode As Long
'Get Column Account
colAuthCode = WorksheetFunction.Match("Auth Code", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAuthCode = Split(Cells(1, colAuthCode).Address, "$")(1)
' Sets Column Widths
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).EntireColumn.AutoFit
Worksheets("REPORT").Range(ColumnCustName & ":" & ColumnCustEmail).ColumnWidth = 30
' Turns Word Wrap ON
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).WrapText = TRUE
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).VerticalAlignment = xlVAlignTop
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).HorizontalAlignment = xlHAlignLeft
Worksheets("REPORT").Range("A1").EntireRow.Font.Bold = TRUE
Worksheets("REPORT").Range("A1").EntireRow.Font.Size = 12
' Set Page Settings
ActiveSheet.Range(ColumnUser & ":" & ColumnAuthCode).CurrentRegion
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = FALSE
.FitToPagesWide = 1
.FitToPagesTall = FALSE
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
End With
'Finds the last non-blank cell in a single row or column
Dim lRow As Long
'Find the last non-blank cell
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' Row color change
Dim i As Integer
For i = 2 To lRow
If i Mod 2 = 0 Then
ActiveSheet.Range(ActiveSheet.Cells(i, 1), ActiveSheet.Cells(i, lCol)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
Next i
' Add Totals
Dim LastRow As Long
Dim bottomRow As Long
LastRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
If LastRow >= 2 Then
Cells(LastRow + 2, ColumnAmount).Formula = "=SUM(" & ColumnAmount & "2" & ":" & ColumnAmount & LastRow & ")"
ElseIf LastRow < 2 Then
Cells(LastRow + 2, ColumnAmount).Value = Range(ColumnAmount & "2").Value
End If
Cells(lRow + 2, ColumnCustEmail).Value = "Total:"
bottomRow = lRow + 2
Let Copyrange = ColumnCustEmail & bottomRow & ":" & ColumnAmount & bottomRow
Range(Copyrange).BorderAround _
ColorIndex:=3, Weight:=xlThick
Range(Copyrange).Font.Bold = TRUE
Range(Copyrange).Font.Size = 14
' Add Auto Print HERE
Worksheets("REPORT").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.DisplayAlerts = FALSE
Application.Quit
End If
End Sub
'*********End of CCs**********
Else
' CODE if column is Not Found
'********CHECKS********
'DELETES UNUSED COLUMNS
Dim currentColumn As Integer
Dim columnHeading As String
ActiveSheet.Columns("Z").Delete
For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value
'CHECK WHETHER TO KEEP THE COLUMN
Select Case columnHeading
Case "User", "Payment Date", "Account", "Customer Name", "Customer Email", "Amount", "Comment"
'Do nothing
Case Else
'Delete if the cell doesn't contain "Homer"
If InStr(1, _
ActiveSheet.UsedRange.Cells(1, currentColumn).Value, _
"Homer", vbBinaryCompare) = 0 Then
ActiveSheet.Columns(currentColumn).Delete
End If
End Select
Next
'Format Sheets
'****Column User****
Dim colUser As Long
Dim ColumnUser As Long
'Get Column User
colUser = WorksheetFunction.Match("User", Rows("1:1"), 0)
'Convert To Column Letter
ColumnUser = Split(Cells(1, colUser).Address, "$")(1)
'****Column PaymentDate****
Dim colPaymentDate As Long
Dim ColumnPaymentDate As Long
'Get Column PaymentDate
colPaymentDate = WorksheetFunction.Match("Payment Date", Rows("1:1"), 0)
'Convert To Column Letter
ColumnPaymentDate = Split(Cells(1, colPaymentDate).Address, "$")(1)
'****Column Account****
Dim colAccount As Long
Dim ColumnAccount As Long
'Get Column Account
colAccount = WorksheetFunction.Match("Account", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAccount = Split(Cells(1, colAccount).Address, "$")(1)
'****Column CustName****
Dim colCustName As Long
Dim ColumnCustName As Long
'Get Column Account
colCustName = WorksheetFunction.Match("Customer Name", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustName = Split(Cells(1, colCustName).Address, "$")(1)
'****Column CustEmail****
Dim colCustEmail As Long
Dim ColumnCustEmail As Long
'Get Column Account
colCustEmail = WorksheetFunction.Match("Customer Email", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustEmail = Split(Cells(1, colCustEmail).Address, "$")(1)
'****Column Amount****
Dim colAmount As Long
Dim ColumnAmount As Long
'Get Column Account
colAmount = WorksheetFunction.Match("Amount", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAmount = Split(Cells(1, colAmount).Address, "$")(1)
'****Column Comment****
Dim colComment As Long
Dim ColumnComment As Long
'Get Column Account
colComment = WorksheetFunction.Match("Comment", Rows("1:1"), 0)
'Convert To Column Letter
ColumnComment = Split(Cells(1, colComment).Address, "$")(1)
' Sets Column Widths
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).EntireColumn.AutoFit
Worksheets("REPORT").Range(ColumnCustName & ":" & ColumnCustEmail).ColumnWidth = 30
Worksheets("REPORT").Range(ColumnComment & ":" & ColumnComment).ColumnWidth = 50
' Turns Word Wrap ON
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).WrapText = TRUE
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).VerticalAlignment = xlVAlignTop
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).HorizontalAlignment = xlHAlignLeft
Worksheets("REPORT").Range("A1").EntireRow.Font.Bold = TRUE
Worksheets("REPORT").Range("A1").EntireRow.Font.Size = 12
' Set Page Settings
ActiveSheet.Range(ColumnUser & ":" & ColumnComment).CurrentRegion
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = FALSE
.FitToPagesWide = 1
.FitToPagesTall = FALSE
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
End With
'Finds the last non-blank cell in a single row or column
Dim lRow As Long
'Find the last non-blank cell
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' Row color change
Dim i As Integer
For i = 2 To lRow
If i Mod 2 = 0 Then
ActiveSheet.Range(ActiveSheet.Cells(i, 1), ActiveSheet.Cells(i, lCol)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
Next i
' Add Totals
Dim LastRow As Long
Dim bottomRow As Long
LastRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
If LastRow >= 2 Then
Cells(LastRow + 2, ColumnAmount).Formula = "=SUM(" & ColumnAmount & "2" & ":" & ColumnAmount & LastRow & ")"
ElseIf LastRow < 2 Then
Cells(LastRow + 2, ColumnAmount).Value = Range(ColumnAmount & "2").Value
End If
Cells(lRow + 2, ColumnCustEmail).Value = "Total:"
bottomRow = lRow + 2
Let Copyrange = ColumnCustEmail & bottomRow & ":" & ColumnAmount & bottomRow
Range(Copyrange).BorderAround _
ColorIndex:=3, Weight:=xlThick
Range(Copyrange).Font.Bold = TRUE
Range(Copyrange).Font.Size = 14
' Add Auto Print HERE
Worksheets("REPORT").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.DisplayAlerts = FALSE
Application.Quit
End If
End Sub
'********END CHECKS*********
End If
Next
End With
End Sub
编辑：
所做的更改：
- 折叠并压缩我的代码以删除不需要的空行。
- Tab 正确缩进了代码
- 删除了错误留在其中的结束标记。
- 在遗漏的地方添加了结束标签。
- 添加了变量定义
- 更正了 Object 个参考文献。
- 大量调试。
谢谢大家的帮助。我学到了一些更好的做法，并且能够搞定一切 运行!
问题出在这里：
'*********End of CCs**********
Else
' CODE if column is Not Found
'********CHECKS********
end sub 似乎不合适。要么做一个新的子，要么删除它。
正如评论者所说，使您的制表符对称将大有帮助。另外，写short functions。刚开始做的时候，感觉自己写的子程序太多了。但它使代码更容易理解。
我写了一个 "Main" 子程序，然后让它调用每个其他函数。大大减少了我的错误。
干杯！
首先，始终在代码顶部声明 Option Explicit。如果这样做，那么您将看到许多未声明的变量。此外，您会看到大量重复变量..
特别是关于您的错误消息，这是因为您有一个流氓 Else 并且您还有一个 2 x 流氓 End If 并且您缺少一个 End If.我已经在你的代码中评论了这些。将它们都删除，您的代码将 有效 .
此外，您在一个过程中多次使用了 End Sub。我会在这里假设你真正想要做的是 EXIT sub，从而代替 Exit Sub
我通常不会审查和重写代码，但您的代码很乱，缩进不正确，这无疑导致了您遇到的问题。整洁的代码易于阅读，易于编写。然而，我确实赞同上面的观点，即较小的过程是良好的代码编写技巧的关键。
'Shows Open File Dialog Box.
Private Sub CommandButton1_Click()
' Private Sub openDialog()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please Select the file."
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Report Export", "*.csv"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
TextBox1 = .SelectedItems(1)
End If
End With
End Sub
'****************************************
Private Sub Convert_Click()
If TextBox1.Value = "" Then
MsgBox "Please Select a file first!"
Else
Workbooks.Open Filename:=TextBox1ActiveSheet.Name = "REPORT"
'DELETES BLANK ROWS
Dim iCounter As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For iCounter = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(iCounter)) = 0 Then
Selection.Rows(iCounter).EntireRow.Delete
End If
Next iCounter
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
'************************
Dim rngToSearch As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Set rngToSearch = ThisWorkbook.Worksheets("REPORT").Range("A1:Z1")
WhatToFind = Array("Card Type") 'add all Column header that you want to check
With rngToSearch
For iCtr = LBound(WhatToFind) To UBound(WhatToFind)
If WorksheetFunction.CountIf(rngToSearch, WhatToFind(iCtr)) > 0 Then ' Check if column is preset or not
' CODE if column exists
'********START CC********
'DELETES UNUSED COLUMNS
Dim currentColumn As Integer
Dim columnHeading As String
ActiveSheet.Columns("Z").Delete
For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value
'CHECK WHETHER TO KEEP THE COLUMN
Select Case columnHeading
Case "User", "Effective Date", "Account", "Customer Name", "Email", "Auth Amount", "Auth Status", "Auth Code"
'Do nothing
Case Else
'Delete if the cell doesn't contain "Homer"
If InStr(1, ActiveSheet.UsedRange.Cells(1, currentColumn).Value, _
"Homer", vbBinaryCompare) = 0 Then
ActiveSheet.Columns(currentColumn).Delete
End If
End Select
Next
'Format Sheets
'****Column User****
Dim colUser As Long
Dim ColumnUser As Long
'Get Column User
colUser = WorksheetFunction.Match("User", Rows("1:1"), 0)
'Convert To Column Letter
ColumnUser = Split(Cells(1, colUser).Address, "$")(1)
'****Column EffectiveDate****
Dim colEffectiveDate As Long
Dim ColumnEffectiveDate As Long
'Get Column EffectiveDate
colEffectiveDate = WorksheetFunction.Match("Effective Date", Rows("1:1"), 0)
'Convert To Column Letter
ColumnEffectiveDate = Split(Cells(1, colEffectiveDate).Address, "$")(1)
'****Column Account****
Dim colAccount As Long
Dim ColumnAccount As Long
'Get Column Account
colAccount = WorksheetFunction.Match("Account", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAccount = Split(Cells(1, colAccount).Address, "$")(1)
'****Column CustName****
Dim colCustName As Long
Dim ColumnCustName As Long
'Get Column Account
colCustName = WorksheetFunction.Match("Customer Name", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustName = Split(Cells(1, colCustName).Address, "$")(1)
'****Column CustEmail****
Dim colCustEmail As Long
Dim ColumnCustEmail As Long
'Get Column Account
colCustEmail = WorksheetFunction.Match("Email", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustEmail = Split(Cells(1, colCustEmail).Address, "$")(1)
'****Column Amount****
Dim colAmount As Long
Dim ColumnAmount As Long
'Get Column Account
colAmount = WorksheetFunction.Match("Auth Amount", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAmount = Split(Cells(1, colAmount).Address, "$")(1)
'****Column AuthStatus****
Dim colAuthStatus As Long
Dim ColumnAuthStatus As Long
'Get Column Account
colAuthStatus = WorksheetFunction.Match("Auth Status", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAuthStatus = Split(Cells(1, colAuthStatus).Address, "$")(1)
'****Column AuthCode****
Dim colAuthCode As Long
Dim ColumnAuthCode As Long
'Get Column Account
colAuthCode = WorksheetFunction.Match("Auth Code", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAuthCode = Split(Cells(1, colAuthCode).Address, "$")(1)
' Sets Column Widths
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).EntireColumn.AutoFit
Worksheets("REPORT").Range(ColumnCustName & ":" & ColumnCustEmail).ColumnWidth = 30
' Turns Word Wrap ON
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).WrapText = True
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).VerticalAlignment = xlVAlignTop
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnAuthCode).HorizontalAlignment = xlHAlignLeft
Worksheets("REPORT").Range("A1").EntireRow.Font.Bold = True
Worksheets("REPORT").Range("A1").EntireRow.Font.Size = 12
' Set Page Settings
ActiveSheet.Range(ColumnUser & ":" & ColumnAuthCode).CurrentRegion
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
End With
'Finds the last non-blank cell in a single row or column
Dim lRow As Long
'Find the last non-blank cell
lRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' Row color change
Dim i As Integer
For i = 2 To lRow
If i Mod 2 = 0 Then
ActiveSheet.Range(ActiveSheet.Cells(i, 1), ActiveSheet.Cells(i, _
lCol)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
Next i
' Add Totals
Dim LastRow As Long
Dim bottomRow As Long
LastRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False).Row
If LastRow >= 2 Then
Cells(LastRow + 2, ColumnAmount).Formula = "=SUM(" & ColumnAmount & _
"2" & ":" & ColumnAmount & LastRow & ")"
ElseIf LastRow < 2 Then
Cells(LastRow + 2, ColumnAmount).Value = Range(ColumnAmount & _
"2").Value
End If
Cells(lRow + 2, ColumnCustEmail).Value = "Total:"
bottomRow = lRow + 2
Let Copyrange = ColumnCustEmail & bottomRow & ":" & ColumnAmount & bottomRow
Range(Copyrange).BorderAround ColorIndex:=3, Weight:=xlThick
Range(Copyrange).Font.Bold = True
Range(Copyrange).Font.Size = 14
' Add Auto Print HERE
Worksheets("REPORT").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.DisplayAlerts = False
Application.Quit
End If
Exit Sub
'*********End of CCs**********
'==========================================================='
' this is your problem
' Else
' delete this ^^
'==========================================================='
' CODE if column is Not Found
'********CHECKS********
'DELETES UNUSED COLUMNS
ActiveSheet.Columns("Z").Delete
For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value
'CHECK WHETHER TO KEEP THE COLUMN
Select Case columnHeading
Case "User", "Payment Date", "Account", "Customer Name", "Customer Email", "Amount", "Comment"
'Do nothing
Case Else
'Delete if the cell doesn't contain "Homer"
If InStr(1, ActiveSheet.UsedRange.Cells(1, currentColumn).Value, "Homer", _
vbBinaryCompare) = 0 Then
ActiveSheet.Columns(currentColumn).Delete
End If
End Select
Next
'Format Sheets
'****Column User****
'Get Column User
colUser = WorksheetFunction.Match("User", Rows("1:1"), 0)
'Convert To Column Letter
ColumnUser = Split(Cells(1, colUser).Address, "$")(1)
'****Column PaymentDate****
Dim colPaymentDate As Long
Dim ColumnPaymentDate As Long
'Get Column PaymentDate
colPaymentDate = WorksheetFunction.Match("Payment Date", Rows("1:1"), 0)
'Convert To Column Letter
ColumnPaymentDate = Split(Cells(1, colPaymentDate).Address, "$")(1)
'****Column Account****
'Get Column Account
colAccount = WorksheetFunction.Match("Account", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAccount = Split(Cells(1, colAccount).Address, "$")(1)
'****Column CustName****
'Get Column Account
colCustName = WorksheetFunction.Match("Customer Name", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustName = Split(Cells(1, colCustName).Address, "$")(1)
'****Column CustEmail****
'Get Column Account
colCustEmail = WorksheetFunction.Match("Customer Email", Rows("1:1"), 0)
'Convert To Column Letter
ColumnCustEmail = Split(Cells(1, colCustEmail).Address, "$")(1)
'****Column Amount****
'Get Column Account
colAmount = WorksheetFunction.Match("Amount", Rows("1:1"), 0)
'Convert To Column Letter
ColumnAmount = Split(Cells(1, colAmount).Address, "$")(1)
'****Column Comment****
Dim colComment As Long
Dim ColumnComment As Long
'Get Column Account
colComment = WorksheetFunction.Match("Comment", Rows("1:1"), 0)
'Convert To Column Letter
ColumnComment = Split(Cells(1, colComment).Address, "$")(1)
' Sets Column Widths
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).EntireColumn.AutoFit
Worksheets("REPORT").Range(ColumnCustName & ":" & ColumnCustEmail).ColumnWidth = 30
Worksheets("REPORT").Range(ColumnComment & ":" & ColumnComment).ColumnWidth = 50
' Turns Word Wrap ON
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).WrapText = True
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).VerticalAlignment = xlVAlignTop
Worksheets("REPORT").Range(ColumnUser & ":" & ColumnComment).HorizontalAlignment = xlHAlignLeft
Worksheets("REPORT").Range("A1").EntireRow.Font.Bold = True
Worksheets("REPORT").Range("A1").EntireRow.Font.Size = 12
' Set Page Settings
ActiveSheet.Range(ColumnUser & ":" & ColumnComment).CurrentRegion
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
End With
'Finds the last non-blank cell in a single row or column
'Find the last non-blank cell
lRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' Row color change
For i = 2 To lRow
If i Mod 2 = 0 Then
ActiveSheet.Range(ActiveSheet.Cells(i, 1), ActiveSheet.Cells(i, lCol)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
Next i
' Add Totals
LastRow = Cells.Find(What:="*", After:=Range("A1"), _
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
If LastRow >= 2 Then
Cells(LastRow + 2, ColumnAmount).Formula = "=SUM(" & ColumnAmount & "2" & ":" & ColumnAmount & LastRow & ")"
ElseIf LastRow < 2 Then
Cells(LastRow + 2, ColumnAmount).Value = Range(ColumnAmount & "2").Value
End If
Cells(lRow + 2, ColumnCustEmail).Value = "Total:"
bottomRow = lRow + 2
Let Copyrange = ColumnCustEmail & bottomRow & ":" & ColumnAmount & bottomRow
Range(Copyrange).BorderAround _
ColorIndex:=3, Weight:=xlThick
Range(Copyrange).Font.Bold = True
Range(Copyrange).Font.Size = 14
' Add Auto Print HERE
Worksheets("REPORT").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Application.DisplayAlerts = False
Application.Quit
'==========================================================='
' this is your problem
' End If
' delete this ^^
'==========================================================='
Exit Sub
'********END CHECKS*********
'==========================================================='
' this is your problem
' End If
' delete this ^^
'==========================================================='
Next iCtr
End With
'==========================================================='
' this is your problem
End If
' added this ^^
'==========================================================='
End Sub