此代码删除与数组中的文本相同的列。
我需要运行 2-3 次才能删除所有列。
Sub DeleteSpecifcColumn()
Dim xFNum, xFFNum, xCount As Integer
Dim xStr As String
Dim xArrName As Variant
Dim MR, xRg As Range
On Error Resume Next
Set MR = Range("A1:N1")
xArrName = Array("textBox25", "textBox4", "textBox6", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23", "textBox5", "textBox7", "textBox24", "textBox1", "textBox3", "textBox14", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23")
xCount = MR.Count
xStr = xArrName(xFNum)
For xFFNum = xCount To 1 Step -1
Set xRg = MR(1, xFFNum)
For xFNum = 0 To UBound(xArrName)
xStr = xArrName(xFNum)
If xRg.Value = xStr Then xRg.EntireColumn.Delete
Next xFNum
Next
End Sub
以下代码也有同样的问题：
Sub change_header_2()
Cells(1, "A").Value = "Shift"
Cells(1, "B").Value = "Clock In Time"
Cells(1, "C").Value = "First Task"
Cells(1, "D").Value = "Last Task"
Cells(1, "E").Value = "Clock Out"
Cells(1, "F").Value = "User"
Cells(1, "G").Value = "Name"
End Sub
尝试运行一个循环来解决问题，但我不知道如何将其写入子程序中，也不知道如何将其写入运行前一个子程序循环的新子程序中。
Sub DeleteMatchingColumns()
Const HEADER_RANGE As String = "A1:N1"
Dim LookupHeaders(): LookupHeaders = Array( _
"textBox1", "textBox3", "textBox4", "textBox5", "textBox6", _
"1textBox7", "textBox8", "textBox9", "textBox10", "textBox11", _
"textBox12", "textBox14", "textBox19", "textBox22", "textBox23", _
"textBox24", "textBox25")
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim hrg As Range: Set hrg = ws.Range(HEADER_RANGE).Rows(1) ' ensure one row
Dim hcCount As Long: hcCount = hrg.Columns.Count
' In this case, 'hcIndexes' will return a 1D one-based array
' containing the indexes of matches or error values if not matching.
Dim hcIndexes()
If hcCount = 1 Then ' one column of headers
ReDim hcIndexes(1 To 1)
hcIndexes(1) = Application.Match(CStr(hrg.Value), LookupHeaders, 0)
Else ' multiple columns of headers
hcIndexes = Application.Match(hrg, LookupHeaders, 0)
End If
Dim hurg As Range, hc As Long
For hc = 1 To hcCount
If IsNumeric(hcIndexes(hc)) Then ' it's a match
' Combine the matching cells into a range.
If hurg Is Nothing Then
Set hurg = hrg.Cells(hc)
Else
Set hurg = Union(hurg, hrg.Cells(hc))
End If
'Else ' it's not a match; do nothing
End If
Next hc
If hurg Is Nothing Then
MsgBox "No matches found.", vbExclamation
Else
' Delete all matching columns in one go.
hurg.EntireColumn.Delete xlShiftToLeft
MsgBox "Columns deleted.", vbInformation
End If
End Sub
以下是第一个子项目的两个解决方法。
#1 - 循环范围和数组
'declare Worksheet variable to hold the exact sheet - ActiveSheet
is a quite random value
Dim ws As Worksheet
' declare and fill array
Dim xArrName As Variant
xArrName = Array("textBox25", "textBox4", "textBox6", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23", "textBox5", "textBox7", "textBox24", "textBox1", "textBox3", "textBox14", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23")
' declare a range to search values in
Dim workRange As Range
' assign a specific sheet to variable, you may need to change the sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")
' declare iteration variable for columns - it's a good practice to
' grant variables with explanatory names
Dim columnIterator As Integer
'same for array iterator
Dim arrayIterator As Integer
' in case you want to loop through both array and range
' looping through range
For columnIterator = 14 To 1 Step -1
' looping through array
For arrayIterator = LBound(xArrName) To UBound(xArrName)
If ws.Cells(1, columnIterator).Value = xArrName(arrayIterator) Then
ws.Cells(1, columnIterator).EntireColumn.Delete
End If
Next
Next
' do other stuff
#2 - 使用“.Find()”方法
'declare Worksheet variable to hold the exact sheet - ActiveSheet is a quite random value
Dim ws As Worksheet
' declare and fill array
Dim xArrName As Variant
xArrName = Array("textBox25", "textBox4", "textBox6", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23", "textBox5", "textBox7", "textBox24", "textBox1", "textBox3", "textBox14", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23")
' declare a range to search values in
Dim workRange As Range
' assign a specific sheet to variable, you may need to change the sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")
' assign a range with binding to specific sheet
Set workRange = Range(ws.Cells(1, 1), ws.Cells(1, 14))
' that's just for looping through array
' like Nick.McDermaid suggestet
For arrayIterator = LBound(xArrName) To UBound(xArrName)
' in this case I DO know that if there
' will be no matches on .Find() function
' I will get an
' Run-time error '91': Object variable or With block variable not set
' error and can live with that for now
' so I use On Error Resume Next statement to ignore it
On Error Resume Next
workRange.Find(xArrName(arrayIterator)).EntireColumn.Delete
Next
' reset error handler after the loop
Err.Clear
' do other stuff
如果“N”列（O、P、Q、R...等）之后没有任何值，这些方法将正常工作，否则，这些值将向左移动并且范围“A1：N1”可能包含已删除的内容再次值。
这是第二个子项目，尝试使用特定的工作表和单元格来设置值
Sub change_header_2()
'declare Worksheet variable to hold the exact sheet - ActiveSheet is a
quite random value
Dim ws As Worksheet
' assign a specific sheet to variable, you may need to change the sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")
' this construction will add values
' to specific cells on a specific sheet
With ws
.Cells(1, "A").Value = "Shift"
.Cells(1, "B").Value = "Clock In Time"
.Cells(1, "C").Value = "First Task"
.Cells(1, "D").Value = "Last Task"
.Cells(1, "E").Value = "Clock Out"
.Cells(1, "F").Value = "User"
.Cells(1, "G").Value = "Name"
End With
End Sub
最后你应该注意Pᴇʜ关于变量声明的评论。
我不包含任何代码，因为您的代码可以工作，但仅在特殊情况下有效。 这些是。
不带对象限定符的引用是指根据以下内容的工作表
1. Placed in a sheet's code: Refers to the sheet where it is placed
2. Placed in ThisWorkbook or Module: Refers to the ActiveSheet.
With Defined object 限定符指的是定义的对象。
在带有 Me 关键字的代码中，您可以到达运行代码的工作表，但要小心它，因为 Microsoft 没有明确定义它。欲了解更多信息 请参阅 来自 Microsoft
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/me-keyword
因此，在您的代码中，在此表单的范围和单元格属性之前添加工作表名称
Worksheets("name").
其中名称是窗口底部选项卡上给出的工作表的实际名称。
这里似乎发生了一些事情。 我感兴趣的是为什么您需要多次运行代码才能删除所有列。 在我看来，你的
Set MR = Range("A1:N1")另外，声明多个相同类型的变量时，仍然需要声明它们的类型。 例如，
Dim MR, xRg As RangeRangesxRgRangeMRVariantDim MR As Range, xRg As Range以下是您想要执行的操作的配对版本，例如：
Private Sub DeleteColumns()
' Range of cells to look through
Dim HeaderRange As Range
Set HeaderRange = Range("A1:N1")
' Column names we want to delete
Dim BadNames As Variant
BadNames = Array("textBox3", "textBox5")
' Iterate through our range of cells, looking at column names
Dim ii As Long, jj As Long
For ii = HeaderRange.Columns.Count To 1 Step -1
' For each cell in the range, compare its name to the Bad names
For jj = LBound(BadNames) To UBound(BadNames)
' If the name is one of the Bad names, delete the column
If HeaderRange(ii).Value = BadNames(jj) Then
HeaderRange.Columns(ii).EntireColumn.Delete
' We can exit the "jj" loop now, because we've already
' deleted the column
Exit For
End If
Next jj
Next ii
End Sub
这应该足以指导您。 如果这是您希望定期执行的任务，您还可以考虑将其转换为
Sub